home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 February / EnigmA AMIGA RUN 04 (1996)(G.R. Edizioni)(IT)[!][issue 1996-02][Skylink CD III].iso / earcd / editor / fwrap311.lha / FinalWrapper3_11 / FinalWrapper.rexx < prev    next >
OS/2 REXX Batch file  |  1995-10-17  |  52KB  |  2,478 lines

  1. /* $VER: FinalWrapper 3.11 (17.10.95) by NDY's */
  2. version="3.11"
  3. date="17.10.95"
  4. OPTIONS RESULTS
  5. SIGNAL ON ERROR
  6. SIGNAL ON SYNTAX
  7. SIGNAL ON BREAK_C
  8. ARG cliarg
  9. initerr=init()
  10. rxport=ADDRESS()
  11. IF ~(Left(rxport,Length(finalw))=finalw) THEN
  12. DO
  13. DO i=1 TO 20 UNTIL portok
  14. rxport=finalw||i
  15. portok=Show("p",rxport)
  16. END
  17. IF portok THEN ADDRESS VALUE rxport
  18. END
  19. portok=Show("p",rxport)
  20. CALL locale
  21. CALL checkenv
  22. CALL loaddef(1)
  23. pubonly=~check.mscr
  24. IF portok & ~pubonly & fwkey~="" THEN
  25. DO
  26. SIGNAL OFF ERROR
  27. ADDRESS COMMAND ''fwkey''
  28. SIGNAL ON ERROR
  29. IF RC=0 THEN
  30. pubonly=1
  31. ELSE
  32. customscr=D2C(RC,4)
  33. END
  34. ELSE
  35. pubonly=1
  36. IF portok THEN
  37. DO
  38. GetDocItemPrefs "DECIMAL"
  39. deci=Upper(RESULT)
  40. DocItemPrefs "DECIMAL PERIOD" 
  41. CALL options
  42. CALL chosenobjs
  43. CALL oval
  44. CALL scan
  45. CALL resetprefs
  46. END
  47. meas=measure.1
  48. IF portok THEN
  49. DO
  50. GetDisplayPrefs "MEASURE"
  51. RESULT=Upper(RESULT)
  52. SELECT
  53. WHEN RESULT="INCHES" THEN meas=measure.2
  54. WHEN RESULT="METRIC" THEN meas=measure.3
  55. WHEN RESULT="PICA" THEN meas=measure.4
  56. OTHERWISE NOP
  57. END
  58. END
  59. DO id=agads+1 TO agads+sgads
  60. ltxt.id=replacepat(ltxt.id,"@m",meas)
  61. END
  62. IF guiinit()=5 THEN CALL message(50,nogui)
  63. init=0
  64. DO FOREVER
  65. CALL OnMenu(win,1024)
  66. IF ~zoomed THEN CALL ZipWindow(win)
  67. CALL ScreenToFront(scr)
  68. CALL ActivateWindow(win)
  69. CALL SetWindowTitles(win,wintitle,scrtitle)
  70. IF Left(text,Min(len.tgad,Length(text)))~=val.tgad THEN text=val.tgad
  71. DO UNTIL portok
  72. closed=0
  73. DO UNTIL closed~=0
  74. DO UNTIL closed~=0
  75. CALL WaitPkt(portname)
  76. CALL messy
  77. END
  78. DO id=1 TO agads+sgads
  79. IF labs.id>0 THEN CALL checkstrgad
  80. END
  81. IF closed=winclose | closed=okclose & prefsstore THEN CALL savedef(1)
  82. IF closed=cancelclose | closed=winclose THEN
  83. DO
  84. CALL bye(0)
  85. closed=0
  86. END
  87. IF closed=rxclose THEN
  88. DO
  89. ADDRESS COMMAND "Run >NIL: Rx "||defdir
  90. closed=0
  91. END
  92. IF closed=nextclose THEN
  93. DO
  94. ADDRESS VALUE rxport
  95. portok=1
  96. CALL newdoc
  97. closed=0
  98. END
  99. END
  100. closed=0
  101. portok=Show("P",rxport)
  102. IF ~portok THEN
  103. DO
  104. DO i=1 TO 20 UNTIL portok
  105. rxport=finalw||i
  106. portok=Show("p",rxport)
  107. END
  108. CALL newdoc
  109. END
  110. IF ~portok THEN
  111. CALL message(0,nofw)
  112. ELSE
  113. ADDRESS VALUE rxport
  114. END
  115. zoomed=BitTst(D2C(GETVALUE(win,24,4,"N")),28)
  116. IF ~zoomed THEN CALL ZipWindow(win) 
  117. CALL SetWindowTitles(win,aborttitle,busytitle)
  118. ScreenToFront
  119. CALL OffMenu(win,1024)
  120. GetDocItemPrefs "DECIMAL"
  121. deci=Upper(RESULT)
  122. DocItemPrefs "DECIMAL PERIOD" 
  123. CALL options
  124. IF chosenobjs()=0 THEN
  125. DO
  126. CALL oval
  127. CALL scan
  128. IF closed=0 THEN CALL text
  129. IF closed=0 THEN CALL wrap
  130. IF closed=0 THEN CALL group
  131. CALL updategadgets
  132. IF stilltoreply THEN
  133. DO
  134. CALL Reply(replymsg,0)
  135. stilltoreply=0
  136. END
  137. END
  138. CALL resetprefs
  139. END
  140. CALL bye(5)
  141. init: 
  142. init=1
  143. errtext="@t (#@n)|in line @l"
  144. stdbut="OK"
  145. wintitle=""
  146. lockcnt=0
  147. errtrap=0
  148. getscrn=0
  149. catalog=0
  150. objs=0
  151. sobjs=0
  152. deci=""
  153. et=""
  154. cleangui=0
  155. stilltoreply=0
  156. replymsg="00000000"x
  157. apig=1
  158. lib.apig=0
  159. reqtools=4
  160. lib.reqtools=0
  161. win="00000000"x
  162. defprfs=""
  163. defspecs=""
  164. defcolour=""
  165. deffont=""
  166. portname="FinalWrapperPort"
  167. IF Show("P",portname) THEN
  168. DO
  169. ADDRESS VALUE portname
  170. IF cliarg~="" THEN
  171. INTERPRET cliarg
  172. ELSE
  173. PopFront
  174. CALL bye(0)
  175. END
  176. fwkey="ENVARC:FinalWrapper/FWKeyfile"
  177. libs=5
  178. DO i=1 TO libs
  179. lib.i=0
  180. END
  181. library.apig="apig.library"
  182. library.2="rexxmathlib.library"
  183. library.3="rexxsupport.library"
  184. library.reqtools="rexxreqtools.library"
  185. guidelib=5
  186. library.guidelib="amigaguide.library"
  187. DO libn=1 TO libs
  188. lib.libn=Show("l",library.libn)
  189. IF ~lib.libn THEN lib.libn=AddLib(library.libn,0,-30,0)
  190. IF ~lib.libn & libn~=guidelib & libn~=reqtools THEN RETURN 14
  191. END
  192. help=lib.guidelib
  193. defdir=""
  194. temp=""
  195. preff.1=""
  196. preff.2=""
  197. wb3=1
  198. IF xexists("ENV:Workbench") THEN
  199. IF Open(prefs,"ENV:Workbench","R") THEN
  200. DO
  201. wb3=(ReadLn(prefs)>=39)
  202. CALL Close(prefs)
  203. END
  204. IF xexists("ENV:FinalWrapper") THEN
  205. DO
  206. preff.1="ENV:FinalWrapper/FinalWrapper.def"
  207. temp="ENV:FinalWrapper/FinalWrapper.temp"
  208. foreigntexts="ENV:FinalWrapper/FinalWrapper."
  209. IF Open(prefs,"ENV:FinalWrapper/FWPath","R") THEN
  210. DO
  211. defdir=ReadLn(prefs)
  212. CALL Close(prefs)
  213. END
  214. END
  215. IF xexists("ENVARC:FinalWrapper") THEN
  216. DO
  217. preff.2="ENVARC:FinalWrapper/FinalWrapper.def"
  218. foreigntexts="ENVARC:FinalWrapper/FinalWrapper."
  219. END
  220. finalw="FINALW."
  221. libn=libs
  222. port=0
  223. oldlen=0
  224. oldtxt=0
  225. oldoval=0
  226. oldobjs=0
  227. oldpara=-1
  228. oldppos=-1
  229. oldplen=-1
  230. txt=0
  231. oval=0
  232. rx=0
  233. ry=0
  234. ovalx=""
  235. ovaly=""
  236. ovalw=""
  237. ovalh=""
  238. ovalp=""
  239. text=""
  240. mchks=0
  241. macts=0
  242. agads=0
  243. sgads=0
  244. tgads=0
  245. wgads=0
  246. slines=0
  247. ovalscanned=0
  248. gadgettext=0
  249. virtualtext=1
  250. alen=0
  251. txtrot=0
  252. windowpos=0
  253. prefsstore=1
  254. trapped=0
  255. specs.0=""
  256. font.0=""
  257. colour.0=""
  258. dirtysize=1
  259. sheetused=0
  260. dirtytext=1
  261. obl="00011111122222233333444445555666677778888999AA"
  262. obrot="0006121722273135394245"
  263. RETURN 0
  264. locale: 
  265. return=13 ; esc=27 ; bs=8 ; del=127
  266. test=0 
  267. IF xexists("ENV:") THEN
  268. ok=Open(prefs,"ENV:Language","R")
  269. ELSE
  270. ok=0
  271. IF ok THEN
  272. DO
  273. language=ReadLn(prefs)
  274. CALL Close(prefs)
  275. END
  276. ELSE
  277. language="english"
  278. ok=1
  279. IF xexists(foreigntexts||language) THEN
  280. IF Open(prefs,foreigntexts||language,"R") THEN
  281. DO
  282. DO UNTIL Eof(prefs)
  283. INTERPRET ReadLn(prefs)
  284. END
  285. CALL Close(prefs)
  286. ok=0
  287. END
  288. IF ok THEN 
  289. DO
  290. measure.1="?"
  291. measure.2="Inch"
  292. measure.3="cm"
  293. measure.4="Pica"
  294. docname="FinalWrapperSmall.Guide"
  295. origwintitle="@i - @f"
  296. origscrtitle="@i - @f"
  297. unnamed="Unnamed"
  298. defwinx=0
  299. defwiny=0
  300. aborttitle="<- Abort"
  301. busytitle="@i - Busy working, please wait..."
  302. gnode.0="REQUESTER"
  303. mnode.0="MENU"
  304. stdbut="OK"
  305. errtext="FinalWrapper failed:|@t|in line @l:|<@s>|(errornumber @n)"
  306. noselect="FinalWrapper failed:|First select an object and|a text block or some text|or enter the values in the|appropriate gadgets!"
  307. nolib="FinalWrapper failed:|Couldn't open '@y'"
  308. nofw="Run Final Writer first!"
  309. wrongos="FinalWrapper failed:|At least OS2.0 is required!"
  310. nogui="FinalWrapper failed:|Couldn't open requester!"
  311. notnum="@g|Value must be numeric!"
  312. noreqtools="Couldn't open rexxreqtools.library!"
  313. nohelp="On-line help not available!"
  314. rxcmderr="Unknown Arexx command|or syntax error:|@c"
  315. rxfilerq="Execute Arexx macro:"
  316. rxfileok="OK"
  317. about="FinalWrapper @v (@d)||For suggestions & bugs write to:|    Andreas Weiss|    Dorfstrasse 24|    CH-8212 Nohl|    (Switzerland)||This program is SHAREWARE!|The share is sfr/DM 20 or $15"
  318. arc=newgadget(2,"u",1,360,0,"ARC",0,9999)
  319. ltxt.arc.1="Use arc °: Clockwise"
  320. ltxt.arc.2="Use arc °: Anticlockwise"
  321. beg=newgadget(3,"b",0,0,0,"BEGIN",0,359)
  322. ltxt.beg.1="Begin °: Absolute"
  323. ltxt.beg.2="Begin °: Clockwise"
  324. ltxt.beg.3="Begin °: Anticlockwise"
  325. rot=newgadget(7,"r",0,0,0,"ROTATE",0,359)
  326. ltxt.rot.1="Rotate °: Absolute"
  327. ltxt.rot.2="Rotate °: Like text block"
  328. ltxt.rot.3="Rotate °: Clockwise"
  329. ltxt.rot.4="Rotate °: Anticlockwise"
  330. ltxt.rot.5="Rotate °: Delta clockwise"
  331. ltxt.rot.6="Rotate °: Delta anticlock"
  332. ltxt.rot.7="Rotate  : Title mode"
  333. dlt=newgadget(-4,"d",0,0,0,"DELETE")
  334. ltxt.dlt.1="Delete: Nothing"
  335. ltxt.dlt.2="Delete: Oval only"
  336. ltxt.dlt.3="Delete: Oval and text block"
  337. ltxt.dlt.4="Delete: Copy oval"
  338. grp=newgadget(-3,"g",0,0,0,"GROUP")
  339. ltxt.grp.1="Group: No"
  340. ltxt.grp.2="Group: Selected oval"
  341. ltxt.grp.3="Group: Invisible oval"
  342. wrd=newgadget(-4,"j",0,0,0,"WORDMODE")
  343. ltxt.wrd.1="Join words: No"
  344. ltxt.wrd.2="Join words: Centered"
  345. ltxt.wrd.3="Join words: Align left"
  346. ltxt.wrd.4="Join words: Align right"
  347. spl=newgadget(2,"s",0,25,0,"SPIRAL",1,100)
  348. ltxt.spl.1="Spiral %: Outside > inside"
  349. ltxt.spl.2="Spiral %: Inside > outside"
  350. siz=newgadget(2,"f",0,100,0,"SIZE",1,100)
  351. ltxt.siz.1="Font size %: Decreasing"
  352. ltxt.siz.2="Font size %: Increasing"
  353. zoo=newgadget(3,"z",0,50,0,"ZOOM",1,1000)
  354. ltxt.zoo.1="Zoom %: All"
  355. ltxt.zoo.2="Zoom %: Height"
  356. ltxt.zoo.3="Zoom %: Width"
  357. ink=newgadget(-5,"i",0,0,0,"COLOUR")
  358. ltxt.ink.1="Ink: From text"
  359. ltxt.ink.2="Ink: From oval fill"
  360. ltxt.ink.3="Ink: From oval border"
  361. ltxt.ink.4="Ink: Shadow = oval fill"
  362. ltxt.ink.5="Ink: Shadow = oval border"
  363. adj=newgadget(-5,"a",0,0,0,"ADJUST")
  364. ltxt.adj.1="Adjust: Nothing"
  365. ltxt.adj.2="Adjust: Character size"
  366. ltxt.adj.3="Adjust: Character width"
  367. ltxt.adj.4="Adjust: Apparent width"
  368. ltxt.adj.5="Adjust: Arc"
  369. adjarc=5
  370. pat=newgadget(0,"p",0,0,0,"PATTERN")
  371. ltxt.pat="Pattern from selected text"
  372. xgad=newstr(7,"x",1,"",1,"XPOS")
  373. ltxt.xgad="(@m) X:"
  374. ygad=newstr(7,"y",1,"",1,"YPOS")
  375. ltxt.ygad="Y:"
  376. wgad=newstr(7,"w",1,"",1,"WIDTH")
  377. ltxt.wgad="Width:"
  378. hgad=newstr(7,"h",1,"",1,"HEIGHT")
  379. ltxt.hgad="Height:"
  380. pgad=newstr(4,"#",1,1,0,"PAGE")
  381. ltxt.pgad="# of page:"
  382. tgad=newstr(200,"t",2,"",2,"TEXT")
  383. ltxt.tgad="Text:"
  384. okgad=newbutton("  OK  ","o",RETURN,"OK")
  385. cancelgad=newbutton("Cancel","c",esc,"CANCEL")
  386. closegad=newkey(del,"CLOSE")
  387. zipgad=newkey(" ","ZIP")
  388. depthgad=newkey(bs,"BACK")
  389. mtitle="Settings"
  390. mgad=newchkitem("Gadgets are auto-activated","G",1,"ACTIVATE")
  391. mspl=newchkitem("Adjust arc for spirals","A",1,"IMPROVE")
  392. mwin=newchkitem("Window beneath pointer","W",1,"WINDOW")
  393. mscr=newchkitem("Use Final Writer's screen","U",1,"SCREEN")
  394. mrel=newchkitem("Final Writer Release 3","F",1,"RELEASE")
  395. CALL newitem("","",mnode.0)
  396. mload=newitem("Load","L","LOAD")
  397. msave=newitem("Save","S","SAVE")
  398. mres=newitem("Reset","R","RESET")
  399. mdef=newitem("Defaults","D","DEFAULTS")
  400. CALL newitem("","",mnode.0)
  401. mtext=newitem("Text block preferences","T","TEXTPREFS")
  402. moval=newitem("Oval preferences","O","OVALPREFS")
  403. CALL newitem("","",mnode.0)
  404. mnext=newitem("Next Document","N","NEXT")
  405. mrexx=newitem("Execute Arexx macro...","E","MACRO")
  406. mhelp=newitem("Help...","H","HELP")
  407. mabt=newitem("About...","?","ABOUT")
  408. fwerrtext.5="Instruction didn't succeed"
  409. fwerrtext.10="Instruction failed"
  410. fwerrtext.20="Invalid arguments"
  411. fwerrtext.100="Unknown instruction"
  412. fwerrtext.200="Couldn't open fwarexx.library"
  413. END
  414. RETURN
  415. checkenv: 
  416. about=replacepat(replacepat(about,"@v",version),"@d",date)
  417. info=replacepat(replacepat("FinalWrapper @v by NDY's","@v",version),"@d",date)
  418. origwintitle=replacepat(origwintitle,"@i",info)
  419. origscrtitle=replacepat(origscrtitle,"@i",info)
  420. wtitle=origwintitle
  421. stitle=origscrtitle
  422. busytitle=replacepat(busytitle,"@i",info)
  423. doc=""
  424. CALL newdoc
  425. menus=mchks+macts
  426. gads=agads+tgads+sgads
  427. kgads=gads+wgads
  428. menuoff=kgads
  429. i=32+menuoff
  430. mnode.i=mnode.0
  431. prefsize=agads*4+mchks+4
  432. prefsid="FW30"||D2C(prefsize,2)
  433. tempsize=0
  434. IF temp~="" THEN
  435. DO id=agads+1 TO agads+sgads
  436. tempsize=tempsize+len.id
  437. END
  438. cancelclose=cancelgad-agads
  439. okclose=okgad-agads
  440. winclose=tgads+1
  441. rxclose=winclose+1
  442. nextclose=rxclose+1
  443. DO id=1 TO kgads
  444. IF ~Datatype(lkey.id,"W") THEN lkey.id=C2D(Upper(lkey.id))
  445. END
  446. IF initerr=14 THEN
  447. DO
  448. ln=replacepat(nolib,"@y",library.libn)
  449. CALL message(14,ln)
  450. CALL bye(14)
  451. END
  452. execbase=GETVALUE("4"x,0,4,"P")
  453. osversion=GETVALUE(execbase,20,2,"N")
  454. IF osversion<37 THEN CALL message(10,wrongos)
  455. IF ~xexists(fwkey) THEN fwkey=""
  456. IF help THEN
  457. DO
  458. docfile="HELP:"||language||"/"||docname
  459. IF ~xexists(docfile) THEN
  460. DO
  461. docfile="ENVARC:FinalWrapper/"||docname
  462. IF ~xexists(docfile) THEN help=0
  463. END
  464. END
  465. RETURN
  466. guiinit: 
  467. IF cleangui THEN RETURN 0
  468. pubscr=Null() ; scr=Null() ; win=Null() ; gad=Null() ; scrvinfo=Null() ; menu=Null() ; port=0 ; menustrip=0
  469. cleangui=1
  470. CALL SET_APIG_GLOBALS()
  471. GT_TAGBASE=X2D("80080000")
  472. GTMN_NEWLOOKMENUS=X2C("80080043")
  473. GTCB_SCALED=X2C("80080044")
  474. WA_NEWLOOKMENUS=X2C("80000093")
  475. nullbyte=D2C(0)
  476. port=OpenPort(portname)
  477. IF ~port THEN RETURN 5
  478. pubscr=LockPubScreen("")
  479. IF pubscr=Null() THEN RETURN 5
  480. IF pubonly THEN
  481. scr=pubscr
  482. ELSE
  483. scr=customscr
  484. scrvinfo=GetVisualInfo(scr)
  485. IF scrvinfo=Null() THEN RETURN 5
  486. scrfont=GETVALUE(scr,40,4,"P")
  487. fonth=GETVALUE(scrfont,4,2,"N")
  488. scrrp=D2C(C2D(scr)+84)
  489. glistptr=MAKEPOINTER(0,0,4,MEMF_CLEAR)
  490. IF glistptr=Null() THEN RETURN 5
  491. borderl=GETVALUE(scr,36,1,"N")
  492. borderr=GETVALUE(scr,37,1,"N")
  493. bordert=GETVALUE(scr,35,1,"N")+fonth+1
  494. pubname=""
  495. pubnptr=MAKEPOINTER(0,0,MAXPUBSCREENNAME,MEMF_CLEAR)
  496. IF pubnptr~=Null() THEN
  497. DO
  498. checkscr=GetDefaultPubScreen(pubnptr)
  499. IF checkscr=pubscr THEN pubname=Import(pubnptr)
  500. CALL FREETHIS(pubnptr)
  501. END
  502. IF pubname="" THEN
  503. DO
  504. pubname="Workbench"
  505. usewb=1
  506. END
  507. ELSE
  508. usewb=0
  509. rows=2
  510. gadh=fonth+4
  511. gaddy=gadh+2
  512. DO i=1 TO 3+slines
  513. maxwidth.i=0
  514. END
  515. charw=TextLength(scrrp,"W"||nullbyte,-1) 
  516. intw=charw*4+12   
  517. strminw=charw*2+6
  518. addwidth=30+intw
  519. gperrow=agads%rows+agads//rows
  520. DO id=1 TO agads
  521. k=1+(id>gperrow)
  522. IF labs.id=0 THEN
  523. DO
  524. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)+34
  525. maxwidth.k=Max(maxwidth.k,gwid.id)
  526. END
  527. ELSE
  528. DO
  529. glabels.id=MAKEPOINTER(0,0,4*Abs(labs.id)+4,MEMF_CLEAR)
  530. IF glabels.id=Null() THEN RETURN 5
  531. DO i=1 TO Abs(labs.id) 
  532. lbuf.id.i=MAKEPOINTER(glabels.id,0,Length(ltxt.id.i)+1,MEMF_CLEAR)
  533. IF lbuf.id.i=Null() THEN RETURN 5
  534. CALL Export(lbuf.id.i,ltxt.id.i)
  535. CALL SETVALUE(glabels.id,(i-1)*4,4,"P",lbuf.id.i)
  536. xwid=TextLength(scrrp,ltxt.id.i||nullbyte,-1)+30
  537. IF labs.id>0 THEN xwid=xwid+addwidth
  538. maxwidth.k=Max(maxwidth.k,xwid)
  539. END
  540. END
  541. END
  542. DO i=1 TO slines
  543. nsgads.i=0
  544. END
  545. DO id=agads+1 TO agads+sgads
  546. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)
  547. lin=line.id
  548. maxnr=3+lin
  549. maxwidth.maxnr=maxwidth.maxnr+gwid.id+strminw+12
  550. nsgads.lin=nsgads.lin+1
  551. END
  552. DO id=agads+sgads+1 TO gads
  553. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)+6
  554. maxwidth.3=maxwidth.3+gwid.id+2
  555. END
  556. maxwidth=Max((Max(maxwidth.1,maxwidth.2)+4)*rows-4,maxwidth.3)
  557. DO i=4 TO slines+3
  558. maxwidth=Max(maxwidth,maxwidth.i)
  559. END
  560. winwid=maxwidth+4
  561. winhi=(gperrow+1+slines)*gaddy+6
  562. gadx=borderl+2
  563. gady=bordert+1
  564. gadw=maxwidth%rows-rows*2+2
  565. gadmaxx=winwid+borderl-2
  566. gadmaxy=winhi+bordert-1
  567. id=0
  568. gx=gadx
  569. cyx=gx
  570. chkx=gx+gadw-26
  571. intx=gx+gadw-28-intw
  572. textplace=PLACETEXT_LEFT
  573. DO i=0 TO 1
  574. DO j=0 TO gperrow-1 WHILE id<agads
  575. id=i*gperrow+j+1
  576. gadid=id*3
  577. IF labs.id>0 THEN
  578. DO
  579. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx,gady+j*gaddy,gadw-addwidth,gadh,"",0,gadid,Null())
  580. newgadxb.id=MAKENEWGADGET(scrvinfo,scrfont,chkx,gady+j*gaddy,26,gadh,"",0,gadid+1,Null())
  581. newgadxi.id=MAKENEWGADGET(scrvinfo,scrfont,intx,gady+j*gaddy,intw,gadh,"",0,gadid+2,Null())
  582. IF newgadxb.id=Null() | newgadxi.id=Null() | newgadx.id=Null() THEN RETURN 5
  583. END
  584. ELSE
  585. DO
  586. IF labs.id<0 THEN
  587. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,cyx,gady+j*gaddy,gadw,gadh,"",0,id*3,Null())
  588. ELSE
  589. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,chkx,gady+j*gaddy,26,gadh,ltxt.id,textplace,id*3+1,Null())
  590. IF newgadx.id=Null() THEN RETURN 5
  591. END
  592. END
  593. chkx=gadmaxx-gadw
  594. intx=chkx+28
  595. gx=chkx+addwidth
  596. cyx=chkx
  597. textplace=PLACETEXT_RIGHT
  598. END
  599. gy=gady+gaddy*gperrow
  600. DO i=1 TO slines
  601. gx=gadx
  602. maxnr=i+3
  603. strw=(maxwidth-maxwidth.maxnr)%(nsgads.i)+strminw
  604. DO id=agads+1 TO agads+sgads
  605. IF line.id=i THEN
  606. DO
  607. nsgads.i=nsgads.i-1
  608. IF nsgads.i=0 THEN strw=gadmaxx-(gx+gwid.id+8)
  609. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx+gwid.id+8,gy,strw,gadh,ltxt.id,PLACETEXT_LEFT,id*3+2,Null())
  610. gx=gx+gwid.id+strw+12
  611. IF newgadx.id=Null() THEN RETURN 5
  612. END
  613. END
  614. gy=gy+gaddy
  615. END
  616. gx=gadx+(maxwidth-maxwidth.3)%2
  617. DO id=agads+sgads+1 TO gads
  618. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx,gadmaxy-gadh,gwid.id,gadh,ltxt.id,PLACETEXT_IN,id*3,Null())
  619. gx=gx+gwid.id+4
  620. IF newgadx.id=Null() THEN RETURN 5
  621. END
  622. newgadbv=MAKENEWGADGET(scrvinfo,scrfont,gadx,gadmaxy-gadh-5,maxwidth,2,0,0,Null())
  623. gad=CreateContext(glistptr)
  624. prev=gad
  625. DO id=1 TO gads
  626. IF id>agads THEN
  627. IF id>agads+sgads THEN
  628. DO
  629. checkgad.id=CreateGadget(BUTTON_KIND,prev,newgadx.id,TAG_DONE,0)
  630. prev=checkgad.id
  631. END
  632. ELSE
  633. DO
  634. IF gtype.id=0 THEN
  635. intgad.id=CreateGadget(INTEGER_KIND,prev,newgadx.id,GTIN_NUMBER,val.id,GTIN_MAXCHARS,len.id,STRINGA_EXITHELP,1,TAG_DONE,0)
  636. ELSE
  637. intgad.id=CreateGadget(STRING_KIND,prev,newgadx.id,GTST_STRING,val.id,GTST_MAXCHARS,len.id,STRINGA_EXITHELP,1,TAG_DONE,0)
  638. prev=intgad.id
  639. END
  640. ELSE
  641. IF labs.id=0 THEN
  642. DO
  643. checkgad.id=CreateGadget(CHECKBOX_KIND,prev,newgadx.id,GTCB_CHECKED,check.id,GTCB_SCALED,-1,TAG_DONE,0)
  644. prev=checkgad.id
  645. END
  646. ELSE
  647. IF labs.id>0 THEN
  648. DO
  649. checkgad.id=CreateGadget(CHECKBOX_KIND,prev,newgadxb.id,GTCB_CHECKED,check.id,GTCB_SCALED,-1,TAG_DONE,0)
  650. intgad.id=CreateGadget(INTEGER_KIND,checkgad.id,newgadxi.id,GTIN_NUMBER,val.id,GTIN_MAXCHARS,4,STRINGA_EXITHELP,1,TAG_DONE,0)
  651. cyclegad.id=CreateGadget(CYCLE_KIND,intgad.id,newgadx.id,GTCY_LABELS,glabels.id,GTCY_ACTIVE,cycle.id,TAG_DONE,0)
  652. prev=cyclegad.id
  653. END
  654. ELSE
  655. DO
  656. cyclegad.id=CreateGadget(CYCLE_KIND,prev,newgadx.id,GTCY_LABELS,glabels.id,GTCY_ACTIVE,cycle.id,TAG_DONE,0)
  657. prev=cyclegad.id
  658. END
  659. END
  660. prev=CreateGadget(TEXT_KIND,prev,newgadbv,GTTX_BORDER,-1,TAG_DONE,0)
  661. IF prev=Null() THEN RETURN 5 
  662. mptr=MAKENEWMENU(menus)
  663. IF mptr=Null() THEN RETURN 5
  664. CALL ADDTO_NEWMENU(mptr,NM_TITLE,mtitle,"",0,0,Null())
  665. DO i=1 TO menus
  666. n=menuoff+i
  667. IF ltxt.n="" THEN
  668. mtxt=NM_BARLABEL
  669. ELSE
  670. mtxt=ltxt.n
  671. IF i>mchks THEN
  672. flags=MENUTOGGLE
  673. ELSE
  674. flags=CHECKED*check.n+CHECKIT+MENUTOGGLE
  675. IF Length(mkey.n)~=1 THEN mkey.n=""
  676. CALL ADDTO_NEWMENU(mptr,NM_ITEM,mtxt,mkey.n,flags,0,Null())
  677. END
  678. DROP ltxt
  679. CALL ADDTO_NEWMENU(mptr,NM_END,"","",0,0,Null())
  680. menu=CreateMenus(mptr,TAG_DONE,0)
  681. IF menu=Null() THEN RETURN 5
  682. IF LayoutMenus(menu,scrvinfo,GTMN_NEWLOOKMENUS,-1,TAG_DONE,0)=0 THEN RETURN 5
  683. winidcmp=IDCMP_CHANGEWINDOW+IDCMP_CLOSEWINDOW+IDCMP_GADGETUP+IDCMP_ACTIVEWINDOW+IDCMP_MOUSEBUTTONS+IDCMP_MENUPICK+IDCMP_VANILLAKEY+IDCMP_RAWKEY+IDCMP_MENUHELP
  684. winflags=WFLG_CLOSEGADGET+WFLG_DEPTHGADGET+WFLG_DRAGBAR+WFLG_ACTIVATE
  685. IF check.mwin THEN
  686. DO
  687. ymouse=GETVALUE(scr,16,2,"N")
  688. xmouse=GETVALUE(scr,18,2,"N")
  689. END
  690. ELSE
  691. DO
  692. ymouse=winx+winhi/2
  693. xmouse=winy+winwid/2
  694. END
  695. wtagl=MAKEPOINTER(0,0,104+8,MEMF_CLEAR)
  696. IF wtagl=Null() THEN RETURN 5
  697. wname=MAKEPOINTER(wtagl,0,Length(wintitle)+1,MEMF_CLEAR)
  698. IF wname=Null() THEN RETURN 5
  699. CALL Export(wname,wintitle)
  700. sname=MAKEPOINTER(wtagl,0,Length(scrtitle)+1,MEMF_CLEAR)
  701. IF sname=Null() THEN RETURN 5
  702. CALL Export(sname,scrtitle)
  703. wzipdims=MAKEPOINTER(wtagl,0,8,MEMF_CLEAR)
  704. IF wzipdims=Null() THEN RETURN 5
  705. zipwid=winwid+borderl+borderr
  706. ziphi=bordert
  707. CALL SETVALUE(wzipdims,4,2,"N",zipwid)
  708. CALL SETVALUE(wzipdims,6,2,"N",ziphi)
  709. CALL SETTAGSLOT(wtagl,0,WA_LEFT,"N",Max(xmouse-winwid/2,0))
  710. CALL SETTAGSLOT(wtagl,1,WA_TOP,"N",Max(ymouse-winhi/2,0))
  711. CALL SETTAGSLOT(wtagl,2,WA_INNERWIDTH,"N",winwid)
  712. CALL SETTAGSLOT(wtagl,3,WA_INNERHEIGHT,"N",winhi)
  713. CALL SETTAGSLOT(wtagl,4,WA_IDCMP,"N",winidcmp)
  714. CALL SETTAGSLOT(wtagl,5,WA_FLAGS,"N",winflags)
  715. CALL SETTAGSLOT(wtagl,6,WA_TITLE,"P",wname)
  716. CALL SETTAGSLOT(wtagl,7,WA_SCREENTITLE,"P",sname)
  717. CALL SETTAGSLOT(wtagl,8,WA_GADGETS,"P",gad)
  718. IF pubonly THEN
  719. CALL SETTAGSLOT(wtagl,9,WA_PUBSCREEN,"P",scr)
  720. ELSE
  721. CALL SETTAGSLOT(wtagl,9,WA_CUSTOMSCREEN,"P",scr)
  722. CALL SETTAGSLOT(wtagl,10,WA_ZOOM,"P",wzipdims)
  723. CALL SETTAGSLOT(wtagl,11,WA_NEWLOOKMENUS,"N",-1)
  724. CALL SETTAGSLOT(wtagl,12,WA_MENUHELP,"N",-1)
  725. CALL SETTAGSLOT(wtagl,13,TAG_DONE,"N",0)
  726. win=OpenWindowTagList(portname,Null(),wtagl,0)
  727. IF win=Null() THEN RETURN 5
  728. rp=GETWINDOWRASTPORT(win)
  729. dwid=GETVALUE(win,8,2,"N")-zipwid
  730. dhi=GETVALUE(win,10,2,"N")-ziphi
  731. CALL GT_RefreshWindow(win,Null())
  732. CALL SetMenuStrip(win,menu)
  733. menustrip=1
  734. zoomed=1
  735. RETURN 0
  736. messy: 
  737. IF port=0 THEN RETURN
  738. DO FOREVER
  739. msg=GetPkt(portname)
  740. IF msg=Null() THEN LEAVE
  741. msgclass=GetArg(msg,0)
  742. zipped=GETVALUE(win,10,2,"N")=ziphi
  743. IF ~Datatype(msgclass,"W") THEN
  744. CALL rx
  745. ELSE
  746. DO
  747. code=GetArg(msg,1)
  748. qual=GetArg(msg,2)
  749. gadid=GetArg(msg,9)
  750. CALL Reply(msg,0)
  751. END
  752. actgads=check.mgad & ~zipped
  753. nospiral=~check.spl
  754. IF msgclass=IDCMP_VANILLAKEY THEN
  755. DO
  756. code=C2D(Upper(D2C(code)))
  757. DO id=1 TO kgads
  758. IF code=lkey.id | code=lkey2.id THEN
  759. DO
  760. IF id=zipgad THEN
  761. DO
  762. CALL ZipWindow(win)
  763. LEAVE
  764. END
  765. ELSE
  766. IF id=depthgad THEN
  767. DO
  768. windowpos=~windowpos
  769. IF windowpos THEN
  770. CALL WindowToBack(win)
  771. ELSE
  772. CALL WindowToFront(win)
  773. LEAVE
  774. END
  775. ELSE
  776. IF id>agads+sgads THEN
  777. DO
  778. closed=id-agads
  779. LEAVE
  780. END
  781. IF ~zipped THEN
  782. DO
  783. msgclass=IDCMP_GADGETUP
  784. type=(qual//4)//3
  785. IF labs.id=0 THEN type=1
  786. IF labs.id<0 THEN type=0
  787. IF id>agads THEN type=2
  788. gadid=id*3+type
  789. IF type=2 | (actgads & ~(check.id & type=1)) THEN CALL ActivateGadget(intgad.id,win,Null())
  790. IF type=1 THEN code=~check.id
  791. IF labs.id>=0 & type=1 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,code)
  792. IF type=0 THEN code=(cycle.id+1)//Abs(labs.id)
  793. IF labs.id~=0 & type=0 THEN CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  794. LEAVE
  795. END
  796. END
  797. END
  798. END
  799. SELECT
  800. WHEN msgclass=IDCMP_CLOSEWINDOW THEN closed=winclose
  801. WHEN msgclass=IDCMP_MENUPICK THEN
  802. DO
  803. mnr=(code%32)//32+1
  804. n=menuoff+mnr
  805. IF mnr<=mchks THEN check.n=~check.n
  806. SELECT
  807. WHEN n=mload THEN
  808. CALL loaddef(2)
  809. WHEN n=msave THEN
  810. CALL savedef(2)
  811. WHEN n=mres THEN
  812. CALL loaddef(1)
  813. WHEN n=mdef THEN
  814. CALL loaddef(0)
  815. WHEN n=mabt THEN
  816. CALL message(0,about)
  817. WHEN n=mtext THEN
  818. IF portok THEN
  819. DO
  820. resume="BACKMESSY"
  821. errtrap=10
  822. SelectObject
  823. TextBlockPrefs "PROMPT"
  824. END
  825. WHEN n=moval THEN
  826. IF portok THEN
  827. DO
  828. resume="BACKMESSY"
  829. errtrap=10
  830. SelectObject
  831. OvalPrefs "PROMPT"
  832. END
  833. WHEN n=mnext THEN
  834. DO
  835. x=SubStr(rxport,Length(finalw)+1)
  836. i=x
  837. DO UNTIL Show("P",rxport) | i=x
  838. i=i//20+1
  839. rxport=finalw||i
  840. END
  841. IF x~=i THEN closed=nextclose
  842. END
  843. WHEN n=mrexx THEN
  844. IF lib.reqtools THEN
  845. DO
  846. i=Max(Pos(defdir,':'),LastPos('/',defdir))
  847. resume="BACKMESSY"
  848. errtrap=14
  849. newdir=RTFileRequest(SubStr(defdir,1,i),DelStr(defdir,1,i),rxfilerq,rxfileok,"RT_SCREENTOFRONT=TRUE")
  850. IF newdir~="" THEN
  851. DO
  852. defdir=newdir
  853. IF xexists("ENV:FinalWrapper") THEN 
  854. IF Open(prefs,"ENV:FinalWrapper/FWPath","W") THEN
  855. DO
  856. CALL WriteLn(prefs,defdir)
  857. CALL Close(prefs)
  858. END
  859. closed=rxclose
  860. END
  861. END
  862. WHEN n=mhelp THEN
  863. IF help THEN
  864. DO
  865. IF usewb THEN
  866. CALL WBenchToFront()
  867. ELSE
  868. CALL ScreenToFront(pubscr)
  869. IF wb3 THEN
  870. CALL Shownode(pubname,docfile,"MAIN",1,0)
  871. ELSE
  872. CALL Shownode(pubname,docfile,"MAIN",1)
  873. CALL ScreenToFront(scr)
  874. END
  875. ELSE
  876. CALL message(0,nohelp)
  877. OTHERWISE NOP
  878. END
  879. END
  880. WHEN actgads & (msgclass=IDCMP_ACTIVEWINDOW | msgclass=IDCMP_MOUSEBUTTONS) THEN CALL ActivateGadget(intgad.1,win,Null())
  881. WHEN msgclass=IDCMP_MENUHELP | (code=95 & (msgclass=IDCMP_RAWKEY | msgclass=IDCMP_GADGETUP)) THEN
  882. IF help THEN
  883. DO
  884. IF usewb THEN
  885. CALL WBenchToFront()
  886. ELSE
  887. CALL ScreenToFront(pubscr)
  888. mnr=(code%32)//32+1+menuoff
  889. IF msgclass=IDCMP_MENUHELP THEN
  890. node=mnode.mnr
  891. ELSE
  892. IF zipped THEN
  893. node=gnode.0
  894. ELSE 
  895. DO
  896. ymouse=getshort(C2D(win),12)
  897. xmouse=getshort(C2D(win),14)
  898. gad=GETVALUE(win,62,4,"P")
  899. id=0
  900. IF xmouse>=0 & ymouse>=0 & xmouse<dwid+zipwid & ymouse<dhi+ziphi & gad~=Null() THEN
  901. DO UNTIL gad=Null()
  902. x=getshort(C2D(gad),4)
  903. y=getshort(C2D(gad),6)
  904. w=getshort(C2D(gad),8)
  905. h=getshort(C2D(gad),10)
  906. i=GETVALUE(gad,38,2,"N")
  907. IF xmouse>=x & xmouse<=x+w & ymouse>=y & ymouse<=y+h & i>0 THEN
  908. DO
  909. id=i%3
  910. LEAVE
  911. END
  912. ELSE
  913. gad=GETVALUE(gad,0,4,"P")
  914. END
  915. node=gnode.id
  916. END
  917. IF wb3 THEN
  918. CALL Shownode(pubname,docfile,node,1,0)
  919. ELSE
  920. CALL Shownode(pubname,docfile,node,1)
  921. CALL ScreenToFront(scr)
  922. END
  923. ELSE
  924. CALL message(0,nohelp)
  925. WHEN msgclass=IDCMP_GADGETUP THEN
  926. DO
  927. type=gadid//3
  928. id=gadid%3
  929. SELECT
  930. WHEN id>agads+sgads THEN closed=id-agads 
  931. WHEN type=2 THEN CALL checkstrgad 
  932. WHEN type=1 THEN  
  933. DO
  934. check.id=code
  935. IF labs.id>0 & check.id~=0 & actgads THEN CALL ActivateGadget(intgad.id,win,Null())
  936. END
  937. OTHERWISE 
  938. DO
  939. cycle.id=code
  940. check.id=1
  941. IF labs.id>0 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  942. IF labs.id>0 & actgads THEN CALL ActivateGadget(intgad.id,win,Null())
  943. END
  944. END
  945. END
  946. OTHERWISE NOP
  947. END
  948. IF check.mspl THEN
  949. IF check.spl & nospiral THEN 
  950. DO
  951. cycle.adj=adjarc-1
  952. CALL GT_SetGadgetAttrs(cyclegad.adj,win,Null(),GTCY_ACTIVE,cycle.adj)
  953. END
  954. END
  955. BACKMESSY:
  956. IF trapped THEN
  957. DO
  958. trapped=0
  959. IF err=14 THEN
  960. DO
  961. lib.reqtools=0
  962. CALL message(0,noreqtools)
  963. END
  964. END
  965. RETURN
  966. checkstrgad: 
  967. old=val.id
  968. specialinfo=GETVALUE(intgad.id,34,4,"P")
  969. IF id>agads THEN
  970. DO
  971. IF gtype.id=0 THEN
  972. val.id=GETVALUE(specialinfo,28,4,"N")
  973. ELSE
  974. DO
  975. gval=GETVALUE(specialinfo,0,4,"S")
  976. IF gtype.id=1 & gval~=old THEN
  977. DO
  978. IF gval~="" THEN
  979. IF ~Datatype(replacepat(gval,",","."),"N") THEN
  980. DO
  981. IF closed=okclose THEN closed=0
  982. IF closed=0 THEN CALL message(0,replacepat(notnum,"@g",ltxt.id))
  983. END
  984. ELSE
  985. IF deci="COMMA" THEN
  986. val.id=replacepat(Max(replacepat(gval,",","."),0),".",",")
  987. ELSE
  988. val.id=Max(replacepat(gval,",","."),0)
  989. ELSE
  990. val.id=""
  991. IF val.id~=gval THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,val.id)
  992. END
  993. ELSE
  994. IF gtype.id=2 THEN val.id=gval
  995. END
  996. END
  997. ELSE
  998. DO
  999. gval=GETVALUE(specialinfo,28,4,"N")
  1000. val.id=Max(Min(ubound.id,gval),lbound.id)
  1001. IF val.id~=gval THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  1002. check.id=check.id | (old~=val.id & actgads)
  1003. IF old~=val.id | actgads THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  1004. END
  1005. RETURN
  1006. rx: 
  1007. PARSE VAR msgclass comm ar.1 ar.2 ar.3
  1008. arg1=Upper(ar.1)
  1009. arg2=SubStr(msgclass,Pos(ar.1,msgclass,Length(comm)+1)+Length(ar.1)+1)
  1010. IF Datatype(arg1,"U") THEN INTERPRET "id="||arg1
  1011. comm=Upper(comm)
  1012. full=msgclass
  1013. msgclass=0
  1014. ret=0
  1015. res=0
  1016. SELECT
  1017. WHEN comm="SETVAL" THEN
  1018. IF checksyntax("W") & ar.2~="" THEN
  1019. SELECT
  1020. WHEN id>0 & id<=agads THEN
  1021. IF labs.id>0 & Datatype(ar.2,"W") THEN
  1022. DO
  1023. gadid=id*3+2
  1024. msgclass=IDCMP_GADGETUP
  1025. code=0
  1026. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,ar.2)
  1027. res=val.id
  1028. END
  1029. WHEN id>agads & id<=agads+sgads THEN
  1030. IF Datatype(replacepat(ar.2,",","."),Word("W N A",gtype.id+1)) | gtype.id=2 THEN
  1031. DO
  1032. gadid=id*3+2
  1033. msgclass=IDCMP_GADGETUP
  1034. code=0
  1035. IF gtype.id=2 THEN
  1036. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,arg2)
  1037. ELSE
  1038. IF gtype.id=1 THEN
  1039. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,ar.2)
  1040. ELSE
  1041. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,ar.2)
  1042. res=val.id
  1043. END
  1044. OTHERWISE NOP
  1045. END
  1046. WHEN comm="SETMODE" THEN
  1047. IF checksyntax("W","w") &  id>0 & id<=agads & labs.id~=0 THEN
  1048. DO
  1049. gadid=id*3
  1050. msgclass=IDCMP_GADGETUP
  1051. code=ar.2
  1052. CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  1053. res=cycle.id
  1054. END
  1055. WHEN comm="SETSTATE" THEN
  1056. IF checksyntax("W","w") THEN
  1057. IF id>0 & id<=agads THEN
  1058. IF labs.id>=0 THEN
  1059. DO
  1060. gadid=id*3+1
  1061. msgclass=IDCMP_GADGETUP
  1062. code=(ar.2~=0)
  1063. CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,code)
  1064. res=check.id
  1065. END
  1066. ELSE 
  1067. DO
  1068. gadid=id*3
  1069. msgclass=IDCMP_GADGETUP
  1070. code=(ar.2~=0)
  1071. CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  1072. res=(cycle.id~=0)
  1073. END
  1074. ELSE
  1075. IF id>menuoff & id<=menuoff+mchks THEN
  1076. DO
  1077. check.id=(ar.2~=0)
  1078. CALL ClearMenuStrip(win)
  1079. item=GETVALUE(menu,18,4,"P")
  1080. DO n=menuoff+1 TO id-1
  1081. item=GETVALUE(item,0,4,"P")
  1082. END
  1083. flags=C2D(B2C(BitAnd(C2B(D2C(GETVALUE(item,12,2,"N"),2)),"1111111011111111")))+CHECKED*check.id
  1084. CALL SETVALUE(item,12,2,"N",flags,0)
  1085. CALL ResetMenuStrip(win,menu)
  1086. msgclass=-1
  1087. END
  1088. WHEN comm="GETVAL" THEN
  1089. IF checksyntax("W") & id>0 & ((id<=agads & labs.id>0) | id<=agads+sgads) THEN
  1090. DO
  1091. specialinfo=GETVALUE(intgad.id,34,4,"P")
  1092. IF id>agads & gtype.id~=0 THEN
  1093. DO
  1094. val=GETVALUE(specialinfo,0,4,"S")
  1095. IF gtype.id=1 THEN val=replacepat(val,",",".")
  1096. END
  1097. ELSE
  1098. val=GETVALUE(specialinfo,28,4,"N")
  1099. res=val
  1100. msgclass=-1
  1101. END
  1102. WHEN comm="GETMODE" THEN
  1103. IF checksyntax("W") & id>0 & id<=agads THEN
  1104. DO
  1105. res=cycle.id
  1106. msgclass=-1
  1107. END
  1108. WHEN comm="GETSTATE" THEN
  1109. IF checksyntax("W") & ((id>0 & id<=agads) | (id>menuoff & id<=menuoff+mchks)) THEN
  1110. DO
  1111. IF id>0 & id<=agads & labs.id<0 THEN 
  1112. res=(cycle.id~=0)
  1113. ELSE
  1114. res=check.id
  1115. msgclass=-1
  1116. END
  1117. WHEN comm="USE" THEN
  1118. IF checksyntax("W") THEN
  1119. IF id>=agads+sgads & id<=kgads THEN
  1120. DO
  1121. msgclass=-1
  1122. IF id=zipgad THEN
  1123. CALL ZipWindow(win)
  1124. ELSE
  1125. IF id=depthgad THEN
  1126. DO
  1127. windowpos=~windowpos
  1128. IF windowpos THEN
  1129. CALL WindowToBack(win)
  1130. ELSE
  1131. CALL WindowToFront(win)
  1132. END
  1133. ELSE
  1134. DO
  1135. msgclass=IDCMP_GADGETUP
  1136. code=0
  1137. gadid=id*3
  1138. END
  1139. END
  1140. ELSE
  1141. IF id>menuoff+mchks & id<=menuoff+mchks+macts THEN
  1142. DO
  1143. msgclass=IDCMP_MENUPICK
  1144. code=(id-1-menuoff)*32
  1145. END
  1146. WHEN comm="SETSTYLE" THEN
  1147. IF ar.1>=0 & ar.1<=Length(text) THEN
  1148. DO
  1149. msgclass=-1
  1150. IF ar.1=0 THEN 
  1151. DO
  1152. j=1
  1153. k=Length(text)
  1154. END
  1155. ELSE
  1156. DO
  1157. j=ar.1
  1158. k=j
  1159. END
  1160. y=arg2
  1161. DO i=j TO k
  1162. tprfs=specs.i
  1163. tfontp=font.i
  1164. tcolourp=colour.i
  1165. arg2=y
  1166. DO WHILE arg2~=""
  1167. x=Upper(Word(arg2,1))
  1168. v=Word(arg2,2)
  1169. SELECT
  1170. WHEN Pos(x||"|","SIZE|WIDTH|OBLIQUE|")>0 THEN
  1171. DO
  1172. p=Pos(x,tprfs)
  1173. tprfs=Left(tprfs,p-1)||x v DelWord(SubStr(tprfs,p),1,2) 
  1174. END
  1175. WHEN x="COLOR" THEN
  1176. tcolourp=x v
  1177. WHEN x="FONT" THEN
  1178. tfontp=x v
  1179. WHEN Pos(x||"|","LEADING|POSITION|CASE|STYLE|")>0 THEN NOP 
  1180. OTHERWISE msgclass=0
  1181. END
  1182. arg2=DelWord(arg2,1,2)
  1183. END
  1184. specs.i=tprfs
  1185. font.i=tfontp
  1186. colour.i=tcolourp
  1187. END
  1188. END
  1189. WHEN comm="GETSTYLE" THEN
  1190. IF ar.1>=0 & ar.1<=Length(text) THEN
  1191. DO
  1192. msgclass=-1
  1193. i=ar.1
  1194. IF i=0 THEN
  1195. DO
  1196. specs.i=defspecs
  1197. font.i=deffont
  1198. colour.i=defcolour
  1199. END
  1200. SELECT
  1201. WHEN arg2="" THEN
  1202. res=specs.i colour.i font.i
  1203. WHEN arg2="FONT" THEN
  1204. res=SubStr(font.i,6)
  1205. WHEN arg2="COLOR"THEN
  1206. res=SubStr(colour.i,7)
  1207. WHEN Pos(arg2||"|","SIZE|WIDTH|OBLIQUE|")>0 THEN
  1208. res=Word(SubStr(specs.i,Pos(arg2,specs.i)+Length(arg2)+1),1)
  1209. WHEN Pos(arg2||"|","LEADING|POSITION|CASE|STYLE|")>0 THEN 
  1210. res=Word(SubStr(defspecs,Pos(arg2,defspecs)+Length(arg2)+1),1)
  1211. OTHERWISE msgclass=0
  1212. END
  1213. IF i=0 THEN
  1214. DO
  1215. specs.i=""
  1216. font.i=""
  1217. colour.i=""
  1218. END
  1219. END
  1220. WHEN comm="SET" THEN
  1221. DO
  1222. msgclass=-1
  1223. SELECT
  1224. WHEN Abbrev("PORT",arg1,1) THEN
  1225. DO
  1226. IF Show("P",ar.2) & Left(ar.2,Length(finalw))=finalw THEN rxport=ar.2
  1227. res=rxport
  1228. END
  1229. WHEN Abbrev("SCREEN",arg1,1) THEN
  1230. DO
  1231. IF arg2="" THEN
  1232. stitle=origscrtitle
  1233. ELSE
  1234. stitle=arg2
  1235. scrtitle=replacepat(replacepat(stitle,"@f",doc),"@i",info)
  1236. CALL SetWindowTitles(win,wintitle,scrtitle)
  1237. END
  1238. WHEN Abbrev("WINDOW",arg1,1) THEN
  1239. DO
  1240. IF arg2="" THEN
  1241. wtitle=origwintitle
  1242. ELSE
  1243. wtitle=arg2
  1244. wintitle=replacepat(replacepat(wtitle,"@f",doc),"@i",info)
  1245. CALL SetWindowTitles(win,wintitle,scrtitle)
  1246. END
  1247. WHEN Abbrev("ZIP",arg1,1) THEN
  1248. DO
  1249. res=zipped
  1250. zipped=(ar.2~=0)
  1251. IF zipped~=res THEN CALL ZipWindow(win)
  1252. END
  1253. OTHERWISE msgclass=0
  1254. END
  1255. END
  1256. WHEN comm="GET" THEN
  1257. DO
  1258. msgclass=-1
  1259. SELECT
  1260. WHEN Abbrev("PORT",arg1,1) THEN
  1261. IF portok THEN
  1262. res=rxport
  1263. ELSE
  1264. res=""
  1265. WHEN Abbrev("REQTOOLS",arg1,1) THEN res=lib.reqtools
  1266. WHEN Abbrev("SCREEN",arg1,1) THEN res=scrtitle
  1267. WHEN Abbrev("VERSION",arg1,1) THEN res=version
  1268. WHEN Abbrev("WINDOW",arg1,1) THEN res=wintitle
  1269. WHEN Abbrev("ZIP",arg1,1) THEN res=zipped
  1270. OTHERWISE msgclass=0
  1271. END
  1272. END
  1273. WHEN comm="PREFS" THEN
  1274. DO
  1275. msgclass=-1
  1276. IF Abbrev("STORE",arg1,1) THEN
  1277. DO
  1278. CALL savedef(1)
  1279. prefsstore=0
  1280. END
  1281. ELSE
  1282. IF Abbrev("RESET",arg1,1) THEN
  1283. DO
  1284. CALL loaddef(1)
  1285. prefsstore=1
  1286. END
  1287. ELSE
  1288. CALL loaddef(0)
  1289. END
  1290. WHEN comm="POPFRONT" THEN
  1291. DO
  1292. IF zipped THEN CALL ZipWindow(win)
  1293. CALL WindowToFront(win)
  1294. CALL ScreenToFront(scr)
  1295. CALL ActivateWindow(win)
  1296. msgclass=-1
  1297. END
  1298. WHEN comm="DIE" THEN
  1299. DO
  1300. msgclass=-1
  1301. res=lockcnt
  1302. IF lockcnt=0 THEN
  1303. DO
  1304. CALL Reply(msg,0)
  1305. IF ar.1~="" & Datatype(ar.1,"W") THEN
  1306. IF ar.2~="" THEN
  1307. DO
  1308. CALL message(ar.1,replacepat(ar.2,"_"," "),replacepat(ar.3,"_"," "))
  1309. IF ar.1=0 THEN CALL bye(0)
  1310. END
  1311. ELSE
  1312. CALL bye(ar.1)
  1313. ELSE
  1314. CALL bye(0)
  1315. END
  1316. END
  1317. WHEN comm="MESSAGE" THEN
  1318. DO
  1319. msgclass=-1
  1320. res=message(0,replacepat(ar.1,"_"," "),replacepat(ar.2,"_"," "),replacepat(ar.3,"_"," "))
  1321. END
  1322. WHEN comm="LOCK" THEN
  1323. DO
  1324. msgclass=-1
  1325. IF Abbrev("ON",arg1,2) THEN
  1326. lockcnt=lockcnt+1
  1327. ELSE
  1328. IF Abbrev("OFF",arg1,2) THEN
  1329. lockcnt=Max(0,lockcnt-1)
  1330. ELSE
  1331. IF Abbrev("RESET",arg1,1) THEN
  1332. lockcnt=0
  1333. res=lockcnt
  1334. END
  1335. WHEN comm="ABORT" THEN
  1336. msgclass=-1
  1337. WHEN comm="GO" THEN
  1338. DO
  1339. msgclass=IDCMP_GADGETUP
  1340. code=0
  1341. gadid=okgad*3
  1342. replymsg=msg
  1343. stilltoreply=1
  1344. RETURN
  1345. END
  1346. OTHERWISE NOP
  1347. END
  1348. IF msgclass=0 THEN 
  1349. CALL Reply(msg,5)
  1350. ELSE
  1351. CALL Reply(msg,ret,res)
  1352. IF msgclass=0 THEN CALL message(0,replacepat(rxcmderr,"@c",full))
  1353. RETURN
  1354. quickmessy: 
  1355. IF port=0 THEN RETURN 0
  1356. DO FOREVER
  1357. msg=GetPkt(portname)
  1358. IF msg=Null() THEN LEAVE
  1359. msgclass=GetArg(msg,0)
  1360. IF msgclass=IDCMP_CLOSEWINDOW THEN
  1361. closed=winclose
  1362. ELSE
  1363. IF msgclass=IDCMP_CHANGEWINDOW THEN
  1364. IF ~BitTst(D2C(GETVALUE(win,24,4,"N")),28) THEN CALL ZipWindow(win) 
  1365. IF Datatype(msgclass,"W") THEN
  1366. CALL Reply(msg,0)
  1367. ELSE
  1368. IF Upper(msgclass)="ABORT" THEN
  1369. DO
  1370. closed=winclose
  1371. CALL Reply(msg,0)
  1372. END
  1373. ELSE
  1374. CALL Reply(msg,1)
  1375. END
  1376. RETURN closed~=0
  1377. guiclean: 
  1378. IF cleangui THEN
  1379. DO
  1380. IF pubscr~=Null() THEN CALL UnLockPubScreen(Null(),pubscr)
  1381. IF win~=Null() THEN
  1382. DO
  1383. IF menustrip THEN CALL ClearMenuStrip(win)
  1384. CALL CloseWindow(win)
  1385. END
  1386. IF menu~=Null() THEN CALL FreeMenus(menu)
  1387. IF gad~=Null() THEN CALL FreeGadgets(gad)
  1388. IF scrvinfo~=Null() THEN CALL FreeVisualInfo(scrvinfo)
  1389. IF port THEN CALL ClosePort(portname)
  1390. port=0
  1391. DO id=1 TO gads
  1392. CALL FREETHIS(newgadx.id)
  1393. CALL FREETHIS(newgadxi.id)
  1394. CALL FREETHIS(newgadxb.id)
  1395. CALL FREETHIS(glabels.id)
  1396. END
  1397. CALL FREETHIS(newgadbv)
  1398. CALL FREETHIS(mptr)
  1399. CALL FREETHIS(wtagl)
  1400. CALL FREETHIS(glistptr)
  1401. CALL FREETHIS(pubnptr)
  1402. cleangui=0
  1403. END
  1404. RETURN
  1405. options: 
  1406. GetTextBlockPrefs "TEXTFLOW FLOWDIST TEXT"
  1407. PARSE VAR RESULT defflow deffld deftext
  1408. defprfs=""
  1409. IF defflow~="" THEN defprfs=defprfs "TEXTFLOW" defflow
  1410. IF deffld~="" THEN defprfs=defprfs "FLOWDIST" deffld
  1411. IF deftext~="" THEN defprfs=defprfs "TEXT" deftext
  1412. GetTextBlockTypePrefs "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  1413. PARSE VAR RESULT tsize tlead twid tobl tpos tcase tstyl tcol tfont
  1414. defspecs="SIZE" tsize "LEADING" tlead "WIDTH" twid "OBLIQUE" tobl "POSITION" tpos "CASE" tcase "STYLE" tstyl
  1415. defcolour="COLOR" tcol
  1416. IF Left(tfont,1)~=" " THEN tfont=" "||tfont 
  1417. deffont="FONT"||tfont
  1418. ssize=360
  1419. start="+0"
  1420. Status "PAGES"
  1421. docpages=RESULT
  1422. IF val.xgad~="" THEN ovalx=replacepat(val.xgad,",",".")
  1423. IF val.ygad~="" THEN ovaly=replacepat(val.ygad,",",".")
  1424. IF val.wgad~="" THEN ovalw=replacepat(val.wgad,",",".")
  1425. IF val.hgad~="" THEN ovalh=replacepat(val.hgad,",",".")
  1426. IF val.pgad~=0 THEN ovalp=Min(Max(val.pgad,1),docpages)
  1427. IF Left(text,Min(len.tgad,Length(text)))~=val.tgad THEN
  1428. DO
  1429. text=val.tgad
  1430. gadgettext=1
  1431. virtualtext=1
  1432. END
  1433. rescan=Length(text)=0
  1434. IF check.arc THEN ssize=SubStr("+-",cycle.arc+1,1)||val.arc
  1435. IF check.beg THEN start=SubStr(" -+",cycle.beg+1,1)||val.beg
  1436. titlemd=check.rot & (cycle.rot=6)
  1437. norrot=~check.rot | titlemd
  1438. IF norrot THEN
  1439. rrot=""
  1440. ELSE
  1441. IF cycle.rot=1 THEN
  1442. rrot="="
  1443. ELSE
  1444. IF cycle.rot=0 THEN
  1445. rrot=val.rot
  1446. ELSE
  1447. DO
  1448. rrot=SubStr("+-",cycle.rot//2+1,1)||val.rot
  1449. IF cycle.rot>3 THEN rrot=" "||rrot
  1450. END
  1451. delete=SubStr("- +=",cycle.dlt+1,1)
  1452. ogrp=SubStr(" +-",cycle.grp+1,1)
  1453. dordim=check.spl
  1454. rdim=""
  1455. IF check.spl THEN rdim=SubStr("+-",cycle.spl+1,1)||val.spl
  1456. dohdim=check.siz | check.spl
  1457. hdim=""
  1458. IF check.siz THEN
  1459. hdim=SubStr("+-",cycle.siz+1,1)||val.siz
  1460. ELSE
  1461. IF check.spl THEN hdim=rdim
  1462. doresize=check.zoo
  1463. IF check.zoo THEN
  1464. DO
  1465. resize=val.zoo
  1466. resizek=SubStr("+|-",cycle.zoo+1,1)
  1467. END
  1468. adjust=cycle.adj
  1469. doadj=(adjust>0)
  1470. fillcol=cycle.ink//2
  1471. shadow=cycle.ink=3 | cycle.ink=4
  1472. resetcol=(cycle.ink=0) | shadow
  1473. attr=check.pat
  1474. wordmd=cycle.wrd>0
  1475. wordoff=SubStr(" 0 0+1-1",2*cycle.wrd+1,2)
  1476. charmd=~wordmd
  1477. IF ssize=0 THEN ssize=0.01 
  1478. absstart=0
  1479. IF Verify(Left(start,1),"+-","m")=0 THEN
  1480. DO
  1481. absstart=1
  1482. start=Max(Min(start,360),0)
  1483. END
  1484. ELSE
  1485. start=Max(Min(start,360),-360)
  1486. IF dordim THEN
  1487. rdim=Max(Min(rdim,100),-100)
  1488. ELSE
  1489. ssize=Max(Min(ssize,360),-360)
  1490. IF rdim=0 THEN rdim=0.01
  1491. IF dohdim THEN
  1492. hdim=Max(Min(hdim,100),-100)
  1493. ELSE
  1494. hdim=rdim
  1495. IF hdim=0 THEN hdim=0.01
  1496. IF doresize THEN
  1497. DO
  1498. resizex=Max(Min(resize,1000),5)/100
  1499. resizey=resizex
  1500. resize=resizex
  1501. IF resizek="|" THEN
  1502. resizex=1
  1503. ELSE
  1504. IF resizek="-" THEN resizey=1
  1505. END
  1506. drot=0
  1507. deltarot=0
  1508. dodrot=0
  1509. IF Verify(Left(rrot,1),"+-","m")>0 THEN
  1510. DO
  1511. drot=Max(Min(rrot,360),-360)
  1512. rrot=""
  1513. norrot=1
  1514. END
  1515. ELSE
  1516. IF Left(rrot,1)=" " & rrot~="" THEN
  1517. DO
  1518. deltarot=Max(Min(rrot,360),-360)
  1519. dodrot=1
  1520. rrot=0
  1521. END
  1522. ELSE
  1523. IF rrot~="" & rrot~="=" THEN rrot=Max(Min(rrot,360),-360)
  1524. IF rrot="=" THEN rrot=txtrot||" "
  1525. RETURN
  1526. chosenobjs: 
  1527. ovalrescan=0
  1528. txtrescan=0
  1529. txt=0
  1530. oval=0
  1531. len=0
  1532. FirstObject "SELECTED"
  1533. o=RESULT
  1534. IF o~=0 THEN
  1535. DO
  1536. cnt=0
  1537. DO UNTIL o=0
  1538. gobj.cnt=o
  1539. NextObject o "SELECTED"
  1540. o=RESULT
  1541. cnt=cnt+1
  1542. END
  1543. DO i=0 TO cnt-1 WHILE oval=0 | txt=0
  1544. GetObjectType gobj.i
  1545. IF RESULT=7 THEN txt=gobj.i
  1546. IF RESULT=6 THEN oval=gobj.i
  1547. END
  1548. END
  1549. IF oval=0 THEN
  1550. oval=oldoval
  1551. ELSE
  1552. ovalrescan=1
  1553. IF gadgettext THEN len=Length(text)
  1554. IF gadgettext & ~(init | rescan) THEN txt=0
  1555. CALL getattr
  1556. Status "PARAPOS"
  1557. pos=RESULT
  1558. PARSE VAR pos para ppos x
  1559. Status "PARACHARS"
  1560. plen=RESULT
  1561. IF txt=0 & ~newattr THEN
  1562. IF Words(pos)=4  & (~gadgettext | rescan | init) THEN
  1563. DO
  1564. Extract
  1565. text=RESULT
  1566. len=Length(text)
  1567. IF C2X(Right(text,1))="0A" THEN len=len-1 
  1568. text=""
  1569. MoveToPara para ppos
  1570. virtualtext=0
  1571. ppos=0
  1572. END
  1573. ELSE
  1574. IF plen~=0 & (rescan | ((plen~=oldplen | para~=oldpara | ppos~=oldppos) & ~gadgettext)) THEN
  1575. DO
  1576. len=plen
  1577. text=""
  1578. virtualtext=0
  1579. IF ppos~=0 THEN MoveToPara para 0
  1580. ppos=0
  1581. END
  1582. IF txt>0 THEN
  1583. DO
  1584. GetTextBlockText txt
  1585. text=RESULT
  1586. len=Length(text)
  1587. END
  1588. IF len=0 & text~="" THEN
  1589. DO
  1590. objs=oldobjs
  1591. len=oldlen
  1592. END
  1593. ELSE
  1594. txtrescan=1
  1595. IF (len=0 | oval=0) & ~init THEN
  1596. DO
  1597. IF len=0 & text~="" THEN
  1598. DO
  1599. len=Length(text)
  1600. txtrescan=1
  1601. END
  1602. IF oval=0 & ovalx~="" & ovaly~="" & ovalw~="" & ovalh~="" & ovalp~="" THEN oval=-1
  1603. IF len=0 | oval=0 THEN
  1604. DO
  1605. CALL message(0,noselect)
  1606. RETURN 5
  1607. END
  1608. END
  1609. gadgettext=0
  1610. oldoval=oval
  1611. oldtxt=txt
  1612. oldlen=len
  1613. oldobjs=objs
  1614. oldpara=para
  1615. oldppos=ppos
  1616. oldplen=plen
  1617. redrawchars=1
  1618. RETURN 0
  1619. getattr: 
  1620. newattr=0
  1621. IF ~attr | init THEN RETURN 5
  1622. Status "PARAPOS"
  1623. pos=RESULT
  1624. IF Words(pos)~=4 THEN RETURN 5
  1625. PARSE VAR pos para ppos x
  1626. Extract
  1627. atext=RESULT
  1628. MoveToPara para ppos
  1629. alen=Length(atext)
  1630. IF C2X(Right(atext,1))="0A" THEN alen=alen-1 
  1631. IF alen=0 THEN RETURN 5
  1632. DO i=1 TO alen
  1633. Cursor "RIGHT"
  1634. aspecs.i=gettexttypespecs()
  1635. Status "FONTNAME"
  1636. afont.i="FONT" RESULT
  1637. Status "FONTCOLOR"
  1638. acolour.i="COLOR" RESULT
  1639. IF quickmessy() THEN
  1640. DO
  1641. CALL remobjs
  1642. oldlen=0
  1643. alen=0
  1644. oldobjs=0
  1645. RETURN 5
  1646. END
  1647. END
  1648. MoveToPara para 0
  1649. oldppos=0
  1650. oldpara=para
  1651. Status "PARACHARS"
  1652. oldplen=RESULT
  1653. newattr=1
  1654. RETURN 0
  1655. oval: 
  1656. IF ovalrescan THEN
  1657. DO
  1658. GetObjectRotation oval
  1659. orot=RESULT
  1660. IF orot~=0 THEN SetObjectRotation oval 0
  1661. GetObjectCoords oval
  1662. PARSE VAR RESULT ovalp ovalx ovaly ovalw ovalh
  1663. IF ovalw<0 THEN
  1664. DO
  1665. ovalx=ovalx+ovalw
  1666. ovalw=-ovalw
  1667. END
  1668. IF ovalh<0 THEN
  1669. DO
  1670. ovaly=ovaly+ovalh
  1671. ovalh=-ovalh
  1672. END
  1673. val.xgad=Left(ovalx,Min(len.xgad,Length(ovalx)))
  1674. val.ygad=Left(ovaly,Min(len.ygad,Length(ovaly)))
  1675. val.wgad=Left(ovalw,Min(len.wgad,Length(ovalw)))
  1676. val.hgad=replacepat(Left(ovalh,Min(len.hgad,Length(ovalh)))," ","") 
  1677. val.pgad=Left(ovalp,Min(len.pgad,Length(ovalp)))
  1678. IF deci="COMMA" THEN
  1679. DO
  1680. val.xgad=replacepat(val.xgad,".",",")
  1681. val.ygad=replacepat(val.ygad,".",",")
  1682. val.wgad=replacepat(val.wgad,".",",")
  1683. val.hgad=replacepat(val.hgad,".",",")
  1684. END
  1685. IF cleangui THEN
  1686. DO
  1687. CALL GT_SetGadgetAttrs(intgad.xgad,win,Null(),GTST_STRING,val.xgad)
  1688. CALL GT_SetGadgetAttrs(intgad.ygad,win,Null(),GTST_STRING,val.ygad)
  1689. CALL GT_SetGadgetAttrs(intgad.wgad,win,Null(),GTST_STRING,val.wgad)
  1690. CALL GT_SetGadgetAttrs(intgad.hgad,win,Null(),GTST_STRING,val.hgad)
  1691. CALL GT_SetGadgetAttrs(intgad.pgad,win,Null(),GTIN_NUMBER,val.pgad)
  1692. END
  1693. GetObjectParams oval "TEXTFLOW FLOWDIST LINECOLOR FILLCOLOR"
  1694. PARSE VAR RESULT flow fld ovlcol ovfcol
  1695. IF Left(flow,5)="Right" THEN
  1696. flow="Right"
  1697. ELSE
  1698. IF Left(flow,4)="Left" THEN flow="Left"
  1699. IF delete="=" THEN
  1700. DO
  1701. SelectObject oval
  1702. Copy
  1703. END
  1704. IF delete~="-" & ogrp=" " THEN
  1705. DeleteObject oval
  1706. ELSE
  1707. IF doresize THEN SetObjectCoords oval x+rx*(1-resizex) y+ry*(1-resizey) rx*resizex*2 ry*resizey*2
  1708. ovalscanned=1
  1709. END
  1710. IF oval~=0 THEN
  1711. DO
  1712. GetPageSetup "WIDTH" "HEIGHT"
  1713. PARSE VAR RESULT pagew pageh
  1714. rx=ovalw/2
  1715. ry=ovalh/2
  1716. xm=Min(ovalx,pagew)+rx
  1717. ym=Min(ovaly,pageh)+ry
  1718. page=ovalp
  1719. END
  1720. IF ~ovalscanned THEN 
  1721. DO
  1722. GetOvalPrefs "TEXTFLOW FLOWDIST LINECOLOR FILLCOLOR"
  1723. PARSE VAR RESULT flow fld ovlcol ovfcol
  1724. IF Left(flow,5)="Right" THEN
  1725. flow="Right"
  1726. ELSE
  1727. IF Left(flow,4)="Left" THEN flow="Left"
  1728. orot=0
  1729. END
  1730. IF fillcol THEN
  1731. ovcol=ovfcol
  1732. ELSE
  1733. ovcol=ovlcol
  1734. TextBlockPrefs "TEXTFLOW" flow "FLOWDIST" fld
  1735. IF ~resetcol THEN TextBlockTypePrefs "COLOR" ovcol
  1736. RETURN
  1737. text: 
  1738. usesheet=alen>0 & attr
  1739. IF ~(txtrescan | dirtysize | (sheetused ^ usesheet) | newattr) THEN RETURN
  1740. DO i=1 TO len
  1741. x=SubStr(text,i,1)
  1742. IF usesheet THEN 
  1743. DO
  1744. attrn=(i-1)//alen+1
  1745. TextBlockTypePrefs afont.attrn
  1746. IF resetcol THEN
  1747. TextBlockTypePrefs aspecs.attrn acolour.attrn
  1748. ELSE
  1749. TextBlockTypePrefs aspecs.attrn
  1750. END
  1751. ELSE
  1752. DO
  1753. j=i-1
  1754. IF font.i~=font.j THEN TextBlockTypePrefs font.i
  1755. IF resetcol & (colour.i~=colour.j) THEN
  1756. TextBlockTypePrefs specs.i colour.i
  1757. ELSE
  1758. IF specs.i~=specs.j THEN TextBlockTypePrefs specs.i
  1759. END
  1760. IF Verify(x,'";= ',"M")  THEN x='"'||x||'"'
  1761. DrawTextBlock page xm ym x
  1762. obj.i=RESULT
  1763. objs=objs+1
  1764. IF check.mrel THEN Redraw
  1765. GetObjectCoords
  1766. PARSE VAR RESULT x x x objw.objs objh.objs
  1767. IF quickmessy() THEN
  1768. DO
  1769. CALL remobjs
  1770. dirtysize=1
  1771. oldlen=0
  1772. oldobjs=0
  1773. RETURN
  1774. END
  1775. END
  1776. sheetused=usesheet 
  1777. dirtysize=0
  1778. redrawchars=0
  1779. RETURN
  1780. scan: 
  1781. IF ~(txtrescan | dirtytext) | len=0 THEN RETURN
  1782. IF txt>0 THEN
  1783. DO
  1784. redrawchars=0
  1785. GetObjectTypeSpecs txt "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  1786. PARSE VAR RESULT tsize tlead twid tobl tpos tcase tstyl tcol tfont
  1787. prfs="SIZE" tsize "LEADING" tlead "WIDTH" twid "OBLIQUE" tobl "POSITION" tpos "CASE" tcase "STYLE" tstyl
  1788. colourp="COLOR" tcol
  1789. IF Left(tfont,1)~=" " THEN tfont=" "||tfont 
  1790. fontp="FONT"||tfont
  1791. GetObjectRotation txt
  1792. txtrot=RESULT
  1793. IF delete="+" THEN DeleteObject txt
  1794. IF Right(rrot,1)=" " THEN rrot=txtrot
  1795. virtualtext=0
  1796. DO i=1 TO len
  1797. specs.i=prfs
  1798. font.i=fontp
  1799. colour.i=colourp
  1800. END
  1801. END
  1802. ELSE
  1803. IF virtualtext THEN
  1804. DO i=1 TO len
  1805. specs.i=defspecs
  1806. font.i=deffont
  1807. colour.i=defcolour
  1808. END
  1809. ELSE
  1810. IF text="" | dirtytext THEN
  1811. DO
  1812. text=""
  1813. DO i=1 TO len
  1814. Extract
  1815. x=rembad(RESULT)
  1816. text=text||x
  1817. Cursor "RIGHT"
  1818. specs.i=gettexttypespecs()
  1819. Status "FONTNAME"
  1820. font.i="FONT" RESULT
  1821. Status "FONTCOLOR"
  1822. colour.i="COLOR" RESULT
  1823. IF quickmessy() THEN
  1824. DO
  1825. CALL remobjs
  1826. oldlen=0
  1827. dirtytext=1
  1828. oldobjs=0
  1829. RETURN
  1830. END
  1831. END
  1832. MoveToPara para 0
  1833. val.tgad=Left(text,Min(len.tgad,Length(text)))
  1834. IF cleangui THEN CALL GT_SetGadgetAttrs(intgad.tgad,win,Null(),GTST_STRING,val.tgad)
  1835. END
  1836. dirtytext=0
  1837. IF text~="" THEN
  1838. DO
  1839. IF C2X(Right(text,1))="0A" THEN
  1840. DO
  1841. len=len-1
  1842. text=Left(text,len)
  1843. END
  1844. text=rembad(text)
  1845. old=val.tgad
  1846. val.tgad=Left(text,Min(len.tgad,Length(text)))
  1847. IF cleangui & val.tgad~=old THEN CALL GT_SetGadgetAttrs(intgad.tgad,win,Null(),GTST_STRING,val.tgad)
  1848. END
  1849. RETURN
  1850. initwrap: 
  1851. txtw=0
  1852. wnr=1
  1853. wordbeg=1
  1854. wordw=0
  1855. IF wordmd THEN
  1856. DO
  1857. wn=1
  1858. whi.wn=0
  1859. DO n=1 TO len
  1860. whi.wn=Max(objh.n,whi.wn)
  1861. IF SubStr(text,n,1)=" " | n=len THEN
  1862. DO
  1863. txtw=txtw+whi.wn
  1864. wn=wn+1
  1865. whi.wn=0
  1866. END
  1867. END
  1868. END
  1869. ELSE
  1870. DO n=1 TO len
  1871. txtw=txtw+objw.n
  1872. END
  1873. PI=3.141593
  1874. deg2rad=PI/180
  1875. smin=0.1 
  1876. rx=Max(rx,smin)
  1877. ry=Max(ry,smin)
  1878. sizerad=ssize*deg2rad
  1879. angstep=sizerad/txtw
  1880. IF doresize THEN angstep=angstep/resize
  1881. IF absstart THEN
  1882. angstart=start*deg2rad
  1883. ELSE
  1884. angstart=(ssize-360+start*2)/2*deg2rad
  1885. adone=angstart
  1886. flip=Sign(ssize)
  1887. ssize=ssize<0
  1888. fr=0
  1889. IF dordim THEN
  1890. DO
  1891. fr=(1-Abs(rdim)/100)/sizerad*Sign(rdim)
  1892. IF rdim<0 THEN
  1893. fr0=Abs(rdim)/100
  1894. ELSE
  1895. fr0=1
  1896. END
  1897. ELSE
  1898. qr=1
  1899. IF dohdim THEN
  1900. DO
  1901. fh=(1-Abs(hdim)/100)/sizerad*Sign(hdim)
  1902. IF hdim<0 THEN
  1903. fh0=Abs(hdim)/100
  1904. ELSE
  1905. fh0=1
  1906. END
  1907. ELSE
  1908. qh=1
  1909. wdone=0
  1910. o=0
  1911. rxx=rx
  1912. ryy=ry
  1913. IF doresize THEN
  1914. DO
  1915. rxx=rxx*resizex
  1916. ryy=ryy*resizey
  1917. END
  1918. sobjs=0
  1919. IF titlemd THEN
  1920. DO
  1921. CALL remobjs
  1922. redrawchars=1
  1923. END
  1924. resetprefs=redrawchars | shadow
  1925. recalcchar=resetprefs | wordmd
  1926. usesheet=(alen>0) & attr
  1927. RETURN
  1928. wrap: 
  1929. CALL initwrap
  1930. DO n=1 TO len
  1931. IF recalcchar THEN
  1932. DO
  1933. char=SubStr(text,n,1)
  1934. IF Verify(char,'";= ',"M")  THEN char='"'||char||'"'
  1935. END
  1936. cw=objw.n
  1937. ch=objh.n
  1938. o=obj.n
  1939. IF charmd THEN
  1940. DO
  1941. CALL position
  1942. x=rxx*Sin(f)*qr-cw/2
  1943. y=ryy*Cos(f)*qr
  1944. IF ~check.mrel THEN y=y-ch/2
  1945. END
  1946. IF resetprefs THEN
  1947. DO
  1948. IF usesheet THEN
  1949. DO
  1950. attrn=(n-1)//alen+1
  1951. TextBlockTypePrefs afont.attrn
  1952. IF resetcol THEN
  1953. TextBlockTypePrefs aspecs.attrn acolour.attrn
  1954. ELSE
  1955. TextBlockTypePrefs aspecs.attrn
  1956. END
  1957. ELSE
  1958. DO
  1959. m=n-1
  1960. IF font.n~=font.m THEN TextBlockTypePrefs font.n
  1961. IF resetcol & (colour.n~=colour.m | shadow) THEN
  1962. TextBlockTypePrefs specs.n colour.n
  1963. ELSE
  1964. IF specs.n~=specs.m THEN TextBlockTypePrefs specs.n
  1965. END
  1966. END
  1967. IF titlemd THEN
  1968. DO
  1969. PARSE VAR specs.n "WIDTH" l
  1970. l=Word(l,1)*cw/objw.n
  1971. i=crot+45
  1972. k=(i-i//90)//360
  1973. j=45-i//360+k
  1974. i=X2D(SubStr(obl,Abs(j)+1,1))
  1975. crot=(360+k-Sign(j)*SubStr(obrot,i+i+1,2))//360
  1976. TextBlockTypePrefs "OBLIQUE" Trunc(10*i*Sign(j)/Sqrt(l)+0.5)
  1977. END
  1978. IF wordmd THEN
  1979. DO
  1980. x=wordw
  1981. y=(whi.wnr-objh.n)/2
  1982. wordw=wordw+objw.n
  1983. crot=0
  1984. END
  1985. IF redrawchars THEN
  1986. DO
  1987. DrawTextBlock page x+xm y+ym char
  1988. obj.n=RESULT
  1989. objs=objs+1
  1990. IF check.mrel THEN Redraw
  1991. o=obj.n
  1992. IF cw~=objw.n | ch~=objh.n THEN SetObjectCoords o page x+xm y+ym cw ch
  1993. END
  1994. ELSE
  1995. SetObjectCoords o page x+xm y+ym cw ch
  1996. SetObjectRotation o crot
  1997. IF shadow THEN
  1998. DO
  1999. TextBlockTypePrefs "COLOR" ovcol
  2000. DrawTextBlock page x+xm+rx/10 y+ym+ry/10 char
  2001. sobj.n=RESULT
  2002. sobjs=sobjs+1
  2003. IF check.mrel THEN Redraw
  2004. IF cw~=objw.n | ch~=objh.n THEN SetObjectCoords sobj.n page x+xm+rx/10 y+ym+ry/10 cw ch
  2005. SetObjectRotation sobj.n crot
  2006. END
  2007. IF wordmd THEN
  2008. IF char='" "' | n=len THEN CALL endofword
  2009. IF quickmessy() THEN
  2010. DO
  2011. CALL remobjs
  2012. RETURN
  2013. END
  2014. END
  2015. RETURN
  2016. position: 
  2017. IF doresize THEN
  2018. DO
  2019. cw=cw*resize
  2020. ch=ch*resize
  2021. END
  2022. f=angstart-angstep*(wdone+cw/2)
  2023. wdone=wdone+cw
  2024. IF dordim THEN qr=fr0+fr*(f-angstart)
  2025. IF dohdim THEN
  2026. DO
  2027. qh=fh0+fh*(f-angstart)
  2028. ch=Max(ch*qh,smin)
  2029. cw=Max(cw*qh,smin)
  2030. END
  2031. IF doadj THEN
  2032. IF adjust=4 THEN
  2033. DO
  2034. asize=1.1*cw/radius(adone,rxx,ryy,qr)
  2035. f=adone-asize/2*flip
  2036. adone=adone-asize*flip
  2037. END
  2038. ELSE
  2039. DO
  2040. carc=radius(f,rxx,ryy,qr)*angstep/qr
  2041. IF adjust=1 THEN ch=ch*carc
  2042. IF adjust=3 THEN ch=ch/Sqrt(carc)
  2043. cw=cw*carc
  2044. END
  2045. IF norrot THEN
  2046. crot=720-Trunc(Atan(ryy/rxx*Tan(f))/PI*180)+180*((Cos(f)>0)+ssize)+drot
  2047. ELSE
  2048. DO
  2049. IF dodrot & n=1 THEN rrot=720-Trunc(Atan(ryy/rxx*Tan(f))/PI*180)+180*((Cos(f)>0)+ssize)
  2050. crot=rrot+deltarot*(n-1)//360+360
  2051. END
  2052. crot=crot//360
  2053. RETURN
  2054. endofword: 
  2055. cw=whi.wnr
  2056. ch=1
  2057. CALL position
  2058. x=rxx*Sin(f)*qr-wordw/2
  2059. y=ryy*Cos(f)*qr-whi.wnr
  2060. x=x+wordoff*wordw/2*Sin(crot*deg2rad)
  2061. y=y-wordoff*wordw/2*Cos(crot*deg2rad)
  2062. crot=(crot+270)//360
  2063. IF shadow THEN
  2064. DO
  2065. SelectObject
  2066. DO i=wordbeg TO n
  2067. SelectObject sobj.i "MULTIPLE"
  2068. END
  2069. Group
  2070. CurrentObject
  2071. wsobj.wnr=RESULT
  2072. GetObjectCoords
  2073. SetObjectCoords wsobj.wnr page x+xm+rx/10 y+ym+ry/10 Word(RESULT,4)*ch Word(RESULT,5)*cw/whi.wnr
  2074. SetObjectRotation wsobj.wnr crot
  2075. END
  2076. SelectObject
  2077. DO i=wordbeg TO n
  2078. SelectObject obj.i "MULTIPLE"
  2079. END
  2080. Group
  2081. CurrentObject
  2082. wobj.wnr=RESULT
  2083. GetObjectCoords
  2084. SetObjectCoords wobj.wnr page x+xm y+ym Word(RESULT,4)*ch Word(RESULT,5)*cw/whi.wnr
  2085. SetObjectRotation wobj.wnr crot
  2086. wordbeg=n+1
  2087. wnr=wnr+1
  2088. wordw=0
  2089. RETURN
  2090. group: 
  2091. IF ~ovalrescan & ogrp~=" " THEN
  2092. DO
  2093. DrawOval ovalp ovalx ovaly ovalw ovalh
  2094. oval=RESULT
  2095. ovalrescan=1
  2096. Redraw
  2097. END
  2098. IF ovalrescan THEN
  2099. DO
  2100. IF ogrp="-" THEN
  2101. DO
  2102. SelectObject oval
  2103. SetObjectParams oval "LINEWT NONE FILL TRANSPARENT"
  2104. END
  2105. IF orot~=0 & delete="-" & ogrp=" " THEN SetObjectRotation oval orot
  2106. END
  2107. SelectObject
  2108. IF wordmd THEN
  2109. DO n=1 TO wnr-1
  2110. SelectObject wobj.n "MULTIPLE"
  2111. END
  2112. ELSE
  2113. DO n=1 TO objs
  2114. SelectObject obj.n "MULTIPLE"
  2115. END
  2116. Group
  2117. i=RESULT
  2118. IF ogrp~=" " THEN
  2119. DO
  2120. SelectObject oval "MULTIPLE"
  2121. Group
  2122. END
  2123. objs=0
  2124. IF orot~=0 THEN SetObjectRotation 0 orot
  2125. IF shadow THEN
  2126. DO
  2127. SelectObject
  2128. IF wordmd THEN
  2129. DO n=1 TO wnr-1
  2130. SelectObject wsobj.n "MULTIPLE"
  2131. END
  2132. ELSE
  2133. DO n=1 TO sobjs
  2134. SelectObject sobj.n "MULTIPLE"
  2135. END
  2136. Group
  2137. sobjs=0
  2138. IF orot~=0 THEN SetObjectRotation 0 orot
  2139. ObjectToBack 0
  2140. END
  2141. Redraw
  2142. RETURN
  2143. bye: 
  2144. PARSE ARG errnr
  2145. errtrap=-2
  2146. IF errnr=0 & lockcnt>0 THEN RETURN
  2147. IF stilltoreply THEN CALL Reply(replymsg,10)
  2148. IF catalog~=0 THEN CALL CloseCatalog(catalog)
  2149. CALL resetprefs
  2150. CALL guiclean
  2151. CALL remobjs
  2152. EXIT errnr
  2153. RETURN
  2154. remobjs: 
  2155. IF objs>0 THEN
  2156. DO
  2157. IF wordmd THEN
  2158. DO n=1 TO wnr-1
  2159. SelectObject wobj.n
  2160. UnGroup
  2161. END
  2162. SelectObject
  2163. DO n=1 TO objs
  2164. SelectObject obj.n "MULTIPLE"
  2165. END
  2166. Group
  2167. DeleteObject
  2168. objs=0
  2169. END
  2170. IF sobjs>0 THEN
  2171. DO
  2172. SelectObject
  2173. IF wordmd THEN
  2174. DO n=1 TO wnr-1
  2175. SelectObject wsobj.n
  2176. UnGroup
  2177. END
  2178. DO n=1 TO sobjs
  2179. SelectObject sobj.n "MULTIPLE"
  2180. END
  2181. Group
  2182. DeleteObject
  2183. sobjs=0
  2184. END
  2185. RETURN
  2186. resetprefs: 
  2187. IF deci~="" THEN DocItemPrefs "DECIMAL PERIOD"
  2188. IF defprfs~="" THEN TextBlockPrefs defprfs
  2189. IF defspecs~="" | defcolour~="" THEN TextBlockTypePrefs defspecs defcolour
  2190. IF deffont~="" THEN TextBlockTypePrefs deffont
  2191. IF deci~="" THEN DocItemPrefs "DECIMAL" deci
  2192. RETURN
  2193. loaddef: 
  2194. ARG where
  2195. CALL loadtemp
  2196. IF where>0 THEN
  2197. DO
  2198. ok=0
  2199. DO i=where TO 3-where BY 3-where*2 UNTIL ok
  2200. IF preff.i~="" THEN
  2201. DO
  2202. ok=Open(prefs,preff.i,"R")
  2203. IF ok THEN
  2204. DO
  2205. default=ReadCh(prefs,prefsize+6)
  2206. CALL Close(prefs)
  2207. END
  2208. END
  2209. END
  2210. END
  2211. ELSE
  2212. default=""
  2213. IF Length(default)~=prefsize+6 | Left(default,6)~=prefsid | C2D(SubStr(default,5,2))~=prefsize THEN default=""
  2214. IF default="" THEN 
  2215. DO
  2216. winx=defwinx
  2217. winy=defwiny
  2218. DO id=1 TO agads
  2219. check.id=defchk.id
  2220. cycle.id=defcyc.id
  2221. val.id=defval.id
  2222. END
  2223. DO id=menuoff+1 TO menuoff+mchks
  2224. check.id=defchk.id
  2225. END
  2226. DO id=agads+1 TO agads+sgads
  2227. IF gtype.id=0 THEN
  2228. val.id=1
  2229. ELSE
  2230. val.id=""
  2231. END
  2232. END
  2233. ELSE 
  2234. DO
  2235. winx=C2D(SubStr(default,7,2))
  2236. winy=C2D(SubStr(default,9,2))
  2237. DO id=1 TO agads
  2238. i=id*4
  2239. check.id=C2D(SubStr(default,i+7,1))~=0
  2240. cycle.id=Min(Max(C2D(SubStr(default,i+8,1)),0),Abs(labs.id))
  2241. val.id=Min(Max(C2D(SubStr(default,i+9,2)),0),9999)
  2242. END
  2243. DO id=menuoff+1 TO menuoff+mchks
  2244. check.id=C2D(SubStr(default,id+agads*4-menuoff+10,1))~=0
  2245. END
  2246. END
  2247. CALL updategadgets
  2248. RETURN
  2249. savedef: 
  2250. ARG where
  2251. CALL savetemp
  2252. winx=GETVALUE(win,4,2,"N")
  2253. winy=GETVALUE(win,6,2,"N")
  2254. default=prefsid||D2C(winx,2)||D2C(winy,2)
  2255. DO id=1 TO agads
  2256. default=default||D2C(check.id,1)||D2C(cycle.id,1)||D2C(val.id,2)
  2257. END
  2258. DO id=menuoff+1 TO menuoff+mchks
  2259. default=default||D2C(check.id,1)
  2260. END
  2261. DO i=1 TO where
  2262. IF preff.i~="" THEN
  2263. DO
  2264. ok=Open(prefs,preff.i,"W")
  2265. IF ok THEN
  2266. DO
  2267. CALL WriteCh(prefs,default)
  2268. CALL Close(prefs)
  2269. END
  2270. END
  2271. END
  2272. RETURN
  2273. loadtemp: 
  2274. IF tempsize=0 THEN RETURN
  2275. ok=Open(prefs,temp,"R")
  2276. IF ok THEN
  2277. DO
  2278. default=ReadCh(prefs,tempsize)
  2279. i=1
  2280. IF Length(default)=tempsize THEN
  2281. DO id=agads+1 TO agads+sgads
  2282. val.id=replacepat(SubStr(default,i,len.id),D2C(0),"")
  2283. i=i+len.id
  2284. END
  2285. CALL Close(prefs)
  2286. END
  2287. RETURN
  2288. savetemp: 
  2289. IF tempsize=0 THEN RETURN
  2290. ok=Open(prefs,temp,"W")
  2291. IF ok THEN
  2292. DO
  2293. default=""
  2294. DO id=agads+1 TO agads+sgads
  2295. default=default||Left(val.id,len.id,D2C(0))
  2296. END
  2297. CALL WriteCh(prefs,default)
  2298. CALL Close(prefs)
  2299. END
  2300. RETURN
  2301. updategadgets: 
  2302. IF ~cleangui THEN RETURN
  2303. DO id=1 TO agads
  2304. IF labs.id>=0 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  2305. IF labs.id~=0 THEN CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,cycle.id)
  2306. IF labs.id>0 THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  2307. END
  2308. DO id=agads+1 TO agads+sgads
  2309. IF gtype.id>0 THEN
  2310. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,val.id)
  2311. ELSE
  2312. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  2313. END
  2314. CALL ClearMenuStrip(win)
  2315. item=GETVALUE(menu,18,4,"P")
  2316. DO n=menuoff+1 TO menuoff+mchks
  2317. flags=C2D(B2C(BitAnd(C2B(D2C(GETVALUE(item,12,2,"N"),2)),"1111111011111111")))+CHECKED*check.n
  2318. CALL SETVALUE(item,12,2,"N",flags,0)
  2319. item=GETVALUE(item,0,4,"P")
  2320. END
  2321. CALL ResetMenuStrip(win,menu)
  2322. RETURN
  2323. newdoc: 
  2324. IF portok THEN
  2325. DO
  2326. Status "FILENAME"
  2327. doc=RESULT
  2328. WinToFront
  2329. END
  2330. ELSE
  2331. doc="???"
  2332. IF doc="" THEN doc=unnamed
  2333. wintitle=replacepat(wtitle,"@f",doc)
  2334. scrtitle=replacepat(stitle,"@f",doc)
  2335. IF cleangui THEN
  2336. DO
  2337. CALL SetWindowTitles(win,wintitle,scrtitle)
  2338. IF ~windowpos THEN CALL WindowToFront(win)
  2339. CALL ActivateWindow(win)
  2340. END
  2341. RETURN
  2342. SYNTAX: 
  2343. et=ErrorText(RC)
  2344. ERROR:
  2345. err=RC
  2346. line=SIGL
  2347. IF errtrap=-1 THEN CALL bye(err)
  2348. IF errtrap=-2 THEN EXIT err
  2349. IF err=errtrap THEN
  2350. DO
  2351. errtrap=0
  2352. i=resume
  2353. DROP resume
  2354. trapped=1
  2355. SIGNAL VALUE i
  2356. END
  2357. RESUME:
  2358. errtrap=-1
  2359. IF et="" THEN et=fwerrtext.err
  2360. CALL message(err,replacepat(replacepat(replacepat(replacepat(errtext,"@n",err),"@l",line),"@t",et),"@s",SourceLine(line)))
  2361. CALL bye(err)
  2362. RETURN
  2363. BREAK_C: 
  2364. CALL bye(2)
  2365. RETURN
  2366. rembad: PROCEDURE 
  2367. PARSE ARG t
  2368. bad=XRange("00"x,"1F"x)||XRange("7F"x,"A0"x)
  2369. i=Verify(t,bad,"m")
  2370. l=Length(t)
  2371. DO WHILE i>0
  2372. t=Left(t,i-1) Right(t,l-i)
  2373. i=Verify(t,bad,"m")
  2374. END
  2375. RETURN t
  2376. replacepat: PROCEDURE 
  2377. PARSE ARG str,pat,replc
  2378. p=Pos(pat,str)
  2379. DO WHILE p>0
  2380. str=Left(str,p-1)||replc||SubStr(str,p+Length(pat))
  2381. p=Pos(pat,str)
  2382. END
  2383. RETURN str
  2384. gettexttypespecs: PROCEDURE 
  2385. Status "FONTSIZE"
  2386. p="SIZE" RESULT
  2387. Status "FONTWIDTH"
  2388. p=p "WIDTH" RESULT
  2389. Status "FONTOBLIQUE"
  2390. p=p "OBLIQUE" RESULT
  2391. RETURN p
  2392. radius: PROCEDURE 
  2393. ARG a,rx,ry,v
  2394. rx=rx*Cos(a)
  2395. ry=ry*Sin(a)
  2396. r=v*Sqrt(rx*rx+ry*ry)
  2397. RETURN r
  2398. getshort: PROCEDURE 
  2399. ARG ptr,offset
  2400. a=GETVALUE(D2C(ptr),offset,2,"N")
  2401. IF a>32767 THEN a=a-65536
  2402. RETURN a
  2403. xexists: PROCEDURE 
  2404. PARSE ARG file
  2405. IF Pos(":",file)>0 THEN
  2406. IF Pos(Upper(Left(file,Pos(":",file))),Upper(ShowList("A",,":")||ShowList("V",,":"))||":")>0 THEN
  2407. ok=Exists(file)
  2408. ELSE
  2409. ok=0
  2410. ELSE
  2411. ok=Exists(file)
  2412. RETURN ok
  2413. newchkitem: 
  2414. mchks=mchks+1
  2415. chk=mchks+agads+tgads+wgads+sgads
  2416. PARSE ARG ltxt.chk,mkey.chk,defchk.chk,mnode.chk
  2417. RETURN chk
  2418. newitem: 
  2419. macts=macts+1
  2420. nr=macts+mchks+agads+tgads+wgads+sgads
  2421. PARSE ARG ltxt.nr,mkey.nr,mnode.nr
  2422. RETURN nr
  2423. newgadget: 
  2424. agads=agads+1
  2425. PARSE ARG labs.agads,lkey.agads,defchk.agads,defval.agads,defcyc.agads,gnode.agads,lbound.agads,ubound.agads
  2426. RETURN agads
  2427. newstr: 
  2428. sgads=sgads+1
  2429. gad=sgads+agads
  2430. PARSE ARG len.gad,lkey.gad,line.gad,val.gad,gtype.gad,gnode.gad
  2431. check.gad=0
  2432. cycle.gad=0
  2433. labs.gad=1
  2434. slines=Max(slines,line.gad)
  2435. RETURN gad
  2436. newbutton: 
  2437. tgads=tgads+1
  2438. gad=tgads+agads+sgads
  2439. PARSE ARG ltxt.gad,lkey.gad,lkey2.gad,gnode.gad
  2440. RETURN gad
  2441. newkey: 
  2442. wgads=wgads+1
  2443. gad=agads+tgads+wgads+sgads
  2444. PARSE ARG lkey.gad,gnode.gad
  2445. RETURN gad
  2446. checksyntax: 
  2447. PARSE ARG par.1,par.2,par.3
  2448. ok=1
  2449. DO i=1 TO 3 WHILE par.i~=""
  2450. IF par.i=Upper(par.i) THEN INTERPRET "ar.i="||ar.i 
  2451. ok=ok & Datatype(ar.i,par.i)
  2452. END
  2453. RETURN ok
  2454. message: 
  2455. PARSE ARG xiterr,msgtxt,buttxt,titletxt
  2456. IF msgtxt="" THEN RETURN 0
  2457. IF buttxt="" THEN buttxt=stdbut
  2458. IF titletxt="" THEN titletxt=wintitle
  2459. IF lib.reqtools THEN
  2460. DO
  2461. resume="BACKMSG"
  2462. errtrap=14
  2463. button=RTEZRequest(replacepat(msgtxt,"|","0A"x),buttxt,titletxt)
  2464. END
  2465. BACKMSG:
  2466. IF trapped THEN 
  2467. DO
  2468. trapped=0
  2469. lib.reqtools=0
  2470. END
  2471. IF ~lib.reqtools THEN
  2472. IF lib.apig & cleangui & win~="00000000"x THEN
  2473. button=EasyRequest(win,titletxt,replacepat(msgtxt,"|","0A"x),buttxt,Null(),0,0)
  2474. ELSE
  2475. SAY replacepat(msgtxt,"|","0A"x)
  2476. IF xiterr>0 THEN CALL bye(xiterr)
  2477. RETURN button
  2478.